module Exercise03 where import Text.Printf (printf) import Data.List --(intercalate) --import Debug.Trace -- HA 3.1a) i selectRow :: [[Int]] -> Int -> [Int] selectRow xss i = xss!!i -- HA 3.1a) ii selectColumn :: [[Int]] -> Int -> [Int] selectColumn xss i = [ x!!i | x <- xss] -- HA 3.1a) iii intRoot :: Int -> Int intRoot = floor . sqrt . fromIntegral --return numbers in square as a list. squares are numbered from left to right and top to bottom --e.g. : --[0,1,2] --[3,4,5] --[6,7,8] selectSquare :: [[Int]] -> Int -> [Int] selectSquare xss i = concat [ drop (imnrt) ( take (imnrt + nrt) x) | (x,n) <- zip xss [0..length xss], n >= (idnrt), n < (idnrt + nrt)] where nrt = intRoot $ length xss idnrt = i `div` nrt * nrt imnrt = i `mod` nrt * nrt -- HA 3.1b) isValidSubsection :: [Int] -> Bool isValidSubsection s = length x == length (nub x) where x = filter (/= 0) s isValidSudoku :: [[Int]] -> Bool isValidSudoku xss = 0 == length [x | x <- [0..length xss - 1], not (isValidSubsection (selectSquare xss x)) || not (isValidSubsection (selectRow xss x)) || not (isValidSubsection (selectColumn xss x))] --bool list testSudoku :: [[Int]] testSudoku = [[0,0,0,0,0,0,0,0,0], [0,0,0,3,0,0,0,0,0], [0,0,0,0,0,0,0,0,0], [0,0,7,0,9,0,0,2,0], [0,0,0,0,0,0,0,0,0], [0,0,0,0,0,0,0,0,5], [0,3,3,0,0,0,0,0,0], [0,0,0,0,0,0,0,0,5], [0,0,0,0,0,0,0,0,0]] nullSudoku :: [[Int]] nullSudoku = [[0,0,0,0,0,0,0,0,0], [0,0,0,0,0,0,0,0,0], [0,0,0,0,0,0,0,0,0], [0,0,0,0,0,0,0,0,0], [0,0,0,0,0,0,0,0,0], [0,0,0,0,0,0,0,0,0], [0,0,0,0,0,0,0,0,0], [0,0,0,0,0,0,0,0,0], [0,0,0,0,0,0,0,0,0]] fullSudoku :: [[Int]] fullSudoku = [[5,3,4,6,7,8,9,1,2], [6,7,2,1,9,5,3,4,8], [1,9,8,3,4,2,5,6,7], [8,5,9,7,6,1,4,2,3], [4,2,6,8,5,3,7,9,1], [7,1,3,9,2,4,8,5,6], [9,6,1,5,3,7,2,8,4], [2,8,7,4,1,9,6,3,5], [3,4,5,2,8,6,1,7,9]] dullSudoku :: [[Int]] dullSudoku = [[5,3,4,6,7,8,9,1,2], [6,7,2,1,9,5,3,4,8], [1,9,8,3,4,0,5,6,7], [8,5,9,7,6,1,4,2,3], [4,2,6,8,5,3,7,9,1], [7,1,3,9,2,4,8,5,6], [9,6,1,5,3,0,2,8,4], [2,8,7,4,1,9,6,3,5], [3,4,5,2,8,6,1,0,9]] smallSudoku :: [[Int]] smallSudoku = [[0,0,0,0], [0,0,0,0], [0,0,0,0], [0,0,0,0]] ripSudoku :: [[Int]] ripSudoku = [[0,0,0,0], [0,0,2,0], [0,0,0,3], [0,3,0,3]] -- HA 3.1c) setCell :: [[Int]] -> (Int,Int) -> Int -> [[Int]] setCell xss (j, k) r = a ++ [x ++ [r] ++ tail y] ++ tail b where (a,b) = splitAt j xss (x,y) = splitAt k $ head b -- HA 3.1d) {-WETT-} pFields :: [[Int]] -> (Int, Int) -> [Int] pFields sudoku (x,y) = (([1..length sudoku] \\ selectColumn sudoku x) \\ selectRow sudoku y) \\ selectSquare sudoku (x `div` nrt + y `div` nrt * nrt) where nrt = intRoot $ length sudoku solveSudoku :: [[Int]] -> [[Int]] solveSudoku xss | not (isValidSudoku xss) = [] | otherwise = sShelper xss (0,0) sShelper :: [[Int]] -> (Int, Int) -> [[Int]] sShelper sudoku (x,y) | x == (length sudoku - 1) && y == (length sudoku - 1) = if field /= 0 then sudoku else (if null options then [] else setCell sudoku (y,x) (head options)) | field /= 0 = sShelper sudoku (nx, ny) --if field `notElem` (pFields (setCell sudoku (y,x) 0) (x,y)) then [] else sShelper sudoku (nx, ny) --trace ("jump " ++ show nx ++ "," ++ show ny ++ " " ++ show options) $ sShelper sudoku (nx, ny) | null options = [] | 1 `elem` options && r1 /= [] = r1 --trace (show x ++ "," ++ show y ++ " : " ++ "1") $ sShelper (setCell sudoku (x,y) 1) (nx, ny) | 2 `elem` options && r2 /= [] = r2 --trace (show x ++ "," ++ show y ++ " : " ++ "2") $ sShelper (setCell sudoku (x,y) 2) (nx, ny) | 3 `elem` options && r3 /= [] = r3 --trace (show x ++ "," ++ show y ++ " : " ++ "3") sShelper (setCell sudoku (x,y) 3) (nx, ny) | 4 `elem` options && r4 /= [] = r4 --trace (show x ++ "," ++ show y ++ " : " ++ "4") sShelper (setCell sudoku (x,y) 4) (nx, ny) | 5 `elem` options && r5 /= [] = r5 --trace (show x ++ "," ++ show y ++ " : " ++ "5") sShelper (setCell sudoku (x,y) 5) (nx, ny) | 6 `elem` options && r6 /= [] = r6 --trace (show x ++ "," ++ show y ++ " : " ++ "6") sShelper (setCell sudoku (x,y) 6) (nx, ny) | 7 `elem` options && r7 /= [] = r7 --trace (show x ++ "," ++ show y ++ " : " ++ "7") sShelper (setCell sudoku (x,y) 7) (nx, ny) | 8 `elem` options && r8 /= [] = r8 --trace (show x ++ "," ++ show y ++ " : " ++ "8") sShelper (setCell sudoku (x,y) 8) (nx, ny) | 9 `elem` options && r9 /= [] = r9 --trace (show x ++ "," ++ show y ++ " : " ++ "9") sShelper (setCell sudoku (x,y) 9) (nx, ny) | otherwise = [] where options = pFields sudoku (x,y) (nx,ny) = ((x + 1) `mod` z, y + ((x+1) `div` z)) z = length sudoku field = (sudoku!!y)!!x fieldList = [field] nrt = intRoot $ length sudoku r1 = sShelper (setCell sudoku (y,x) 1) (nx, ny) r2 = sShelper (setCell sudoku (y,x) 2) (nx, ny) r3 = sShelper (setCell sudoku (y,x) 3) (nx, ny) r4 = sShelper (setCell sudoku (y,x) 4) (nx, ny) r5 = sShelper (setCell sudoku (y,x) 5) (nx, ny) r6 = sShelper (setCell sudoku (y,x) 6) (nx, ny) r7 = sShelper (setCell sudoku (y,x) 7) (nx, ny) r8 = sShelper (setCell sudoku (y,x) 8) (nx, ny) r9 = sShelper (setCell sudoku (y,x) 9) (nx, ny) {-TTEW-} testInd :: (Int,Int, Int) -> (Int,Int) testInd (x,y, z) = ((x + 1) `mod` z, y + ((x+1) `div` z)) hardSudoku :: [[Int]] hardSudoku = [[8,0,0,0,0,0,0,0,0], [0,0,3,6,0,0,0,0,0], [0,7,0,0,9,0,2,0,0], [0,5,0,0,0,7,0,0,0], [0,0,0,0,4,5,7,0,0], [0,0,0,1,0,0,0,3,0], [0,0,1,0,0,0,0,6,8], [0,0,8,5,0,0,0,1,0], [0,9,0,0,0,0,4,0,0]] -- Utility method to show a sudoku -- show sudoku with -- >>> putStr (showSudoku sudoku) showSudoku :: [[Int]] -> String showSudoku xss = unlines $ intercalate [showDivider] $ chunksOf squareSize $ map showRow xss where size = length xss squareSize = intRoot size numberSize = size `div` 10 + 1 showRowSection xs = unwords $ map (printf ("%0" ++ show numberSize ++ "d")) xs showRow xs = intercalate "|" $ map showRowSection $ chunksOf squareSize xs showDivider = intercalate "+" $ replicate squareSize $ replicate ((numberSize + 1) * squareSize - 1) '-' chunksOf :: Int -> [e] -> [[e]] chunksOf i [] = [] chunksOf i ls = take i ls : chunksOf i (drop i ls)