diff --git a/samples/Haskell/Hello.hs b/samples/Haskell/Hello.hs new file mode 100644 index 00000000..cef0b4a9 --- /dev/null +++ b/samples/Haskell/Hello.hs @@ -0,0 +1,6 @@ +import Data.Char + +main :: IO () +main = do + let hello = "hello world" + putStrLn $ map toUpper hello \ No newline at end of file diff --git a/samples/Haskell/Main.hs b/samples/Haskell/Main.hs new file mode 100644 index 00000000..4a37a8c0 --- /dev/null +++ b/samples/Haskell/Main.hs @@ -0,0 +1,33 @@ +module Main where + +import Sudoku +import Data.Maybe + + +sudoku :: Sudoku +sudoku = [8, 0, 1, 3, 4, 0, 0, 0, 0, + 4, 3, 0, 8, 0, 0, 1, 0, 7, + 0, 0, 0, 0, 6, 0, 0, 0, 3, + 2, 0, 8, 0, 5, 0, 0, 0, 9, + 0, 0, 9, 0, 0, 0, 7, 0, 0, + 6, 0, 0, 0, 7, 0, 8, 0, 4, + 3, 0, 0, 0, 1, 0, 0, 0, 0, + 1, 0, 5, 0, 0, 6, 0, 4, 2, + 0, 0, 0, 0, 2, 4, 3, 0, 8] + +{- +sudoku :: Sudoku +sudoku = [8, 6, 1, 3, 4, 7, 2, 9, 5, + 4, 3, 2, 8, 9, 5, 1, 6, 7, + 9, 5, 7, 1, 6, 2, 4, 8, 3, + 2, 7, 8, 4, 5, 1, 6, 3, 9, + 5, 4, 9, 6, 8, 3, 7, 2, 1, + 6, 1, 3, 2, 7, 9, 8, 5, 4, + 3, 2, 4, 9, 1, 8, 5, 7, 6, + 1, 8, 5, 7, 3, 6, 9, 4, 2, + 7, 9, 6, 5, 2, 4, 3, 1, 8] +-} +main :: IO () +main = do + putStrLn $ pPrint sudoku ++ "\n\n" + putStrLn $ pPrint $ fromMaybe [] $ solve sudoku \ No newline at end of file diff --git a/samples/Haskell/Sudoku.hs b/samples/Haskell/Sudoku.hs new file mode 100644 index 00000000..ca6122e3 --- /dev/null +++ b/samples/Haskell/Sudoku.hs @@ -0,0 +1,46 @@ +module Sudoku +( + Sudoku, + solve, + isSolved, + pPrint +) where + +import Data.Maybe +import Data.List +import Data.List.Split + +type Sudoku = [Int] + +solve :: Sudoku -> Maybe Sudoku +solve sudoku + | isSolved sudoku = Just sudoku + | otherwise = do + index <- elemIndex 0 sudoku + let sudokus = [nextTest sudoku index i | i <- [1..9], + checkRow (nextTest sudoku index i) index, + checkColumn (nextTest sudoku index i) index, + checkBox (nextTest sudoku index i) index] + listToMaybe $ mapMaybe solve sudokus + where nextTest sudoku index i = take index sudoku ++ [i] ++ drop (index+1) sudoku + checkRow sudoku index = (length $ getRow sudoku index) == (length $ nub $ getRow sudoku index) + checkColumn sudoku index = (length $ getColumn sudoku index) == (length $ nub $ getColumn sudoku index) + checkBox sudoku index = (length $ getBox sudoku index) == (length $ nub $ getBox sudoku index) + getRow sudoku index = filter (/=0) $ (chunksOf 9 sudoku) !! (quot index 9) + getColumn sudoku index = filter (/=0) $ (transpose $ chunksOf 9 sudoku) !! (mod index 9) + getBox sudoku index = filter (/=0) $ (map concat $ concatMap transpose $ chunksOf 3 $ map (chunksOf 3) $ chunksOf 9 sudoku) + !! (3 * (quot index 27) + (quot (mod index 9) 3)) + +isSolved :: Sudoku -> Bool +isSolved sudoku + | product sudoku == 0 = False + | map (length . nub) sudokuRows /= map length sudokuRows = False + | map (length . nub) sudokuColumns /= map length sudokuColumns = False + | map (length . nub) sudokuBoxes /= map length sudokuBoxes = False + | otherwise = True + where sudokuRows = chunksOf 9 sudoku + sudokuColumns = transpose sudokuRows + sudokuBoxes = map concat $ concatMap transpose $ chunksOf 3 $ map (chunksOf 3) $ chunksOf 9 sudoku + +pPrint :: Sudoku -> String +pPrint sudoku = intercalate "\n" $ map (intercalate " " . map show) $ chunksOf 9 sudoku \ No newline at end of file