gistfile1.hs

module Sudoku where

import Data.List           (intersperse, nub, transpose, (\\), minimumBy)
import Control.Applicative ((<$>))
import Control.Monad       (sequence, mapM, guard)

type Position = (Int, Int)

{- D0 is "Unknown" -}
data Digit = D0 | D1 | D2 | D3 | D4 | D5 | D6 | D7 | D8 | D9
    deriving (Eq, Ord, Read, Enum)

mkDigit :: (Integral a, Ord a) => a -> Maybe Digit
mkDigit n
    | n >= 0 && n < 10 = Just $ toEnum $ fromIntegral n
    | otherwise        = Nothing

instance Show Digit where show x = show $ fromEnum x

newtype Sudoku = Sudoku { toList :: [[Digit]] }

instance Show Sudoku where
    show sudoku = concat $ intersperse "\n" $ map show list
        where list = toList sudoku

mkSudoku :: (Integral a) => [[a]] -> Maybe Sudoku
mkSudoku xss = if isSudoku then buildSudoku else Nothing
    where
        isSudoku :: Bool
        isSudoku = outerLength == 9 && (all (== outerLength) $ map length xss)
            where outerLength = length xss

        toDigits :: Maybe [[Digit]]
        toDigits = let listOfMaybes = [map mkDigit y | y <- xss]
                   in mapM sequence $ listOfMaybes

        buildSudoku :: Maybe Sudoku
        buildSudoku = Sudoku <$> toDigits

findValidMoves :: Sudoku -> [([Digit], Position)]
findValidMoves (Sudoku rows) =
    do
        x <- [0..8]
        y <- [0..8]
        guard $ (rows !! y !! x) == D0
        let validMovesForPos = validMoves x y
        guard $ length validMovesForPos > 0

        return (validMovesForPos, (x, y))
    where
        validMoves :: Int -> Int -> [Digit]
        validMoves x y = [D0 ..] \\ (nub $ (rows !! y ++ columns !! x ++ itemsInSquare (x, y)))

        itemsInSquare :: Position -> [Digit]
        itemsInSquare (x, y) = [y'..y'+2] >>= (\idx -> take 3 $ drop x' $ rows !! idx)
            where x' = x - x `mod` 3
                  y' = y - y `mod` 3

        columns = transpose rows

findBestMove :: [([Digit], Position)] -> ([Digit], Position)
findBestMove = minimumBy (\x y -> (options x) `compare` (options y))
    where
        options :: ([Digit], Position) -> Int
        options = length . fst