Merge pull request #1141 from killmous/master

Added samples for Haskell

samples/Haskell/Hello.hs

@@ -0,0 +1,6 @@
+import Data.Char
+
+main :: IO ()
+main = do
+	let hello = "hello world"
+	putStrLn $ map toUpper hello

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

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