Added samples for Haskell

This commit is contained in:
killmous
2014-04-27 11:29:26 -05:00
parent e513ac628a
commit a17f7d1cb2
3 changed files with 85 additions and 0 deletions

6
samples/Haskell/Hello.hs Normal file
View File

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

33
samples/Haskell/Main.hs Normal file
View File

@@ -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

46
samples/Haskell/Sudoku.hs Normal file
View File

@@ -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