Skip to content

Instantly share code, notes, and snippets.

@ykst
Created June 23, 2012 11:14
Show Gist options
  • Save ykst/2977923 to your computer and use it in GitHub Desktop.
Save ykst/2977923 to your computer and use it in GitHub Desktop.
yet another sudoku solver
module Main where
import List (unfoldr, transpose, sort, (\\))
import System.Environment (getArgs)
import Control.Monad (foldM,msum)
type Nums = [Int]
solveProblems :: FilePath -> IO ()
solveFile :: FilePath -> IO ()
solveStr :: String -> String
test :: [[Nums]] -> Maybe [[Nums]]
sep :: Int -> [Nums] -> [Nums] -> Either (Maybe [[[Nums]]]) [[Nums]]
mtxify :: [a]->[[a]]
fill,blk,cmp :: [[Nums]] -> [[Nums]]
main = solveProblems . head =<< getArgs
solveProblems = (mapM_ (putStrLn . solveStr) . parseFile =<<) . readFile
where parseFile :: String -> [String]
parseFile = map (unlines . mtxify . map cnv) . lines
cnv '.' = '0'
cnv c = c
solveFile = (putStrLn . solveStr =<<) . readFile
solveStr = maybe "?" (unlines . map show) . test . initStr
where initStr = map (map getCandidate) . lines
getCandidate '0' = [1..9]
getCandidate x = [read [x]]
test mtx = either (maybe Nothing (msum . map test)) Just (step $ fill mtx)
where step mtx = case filter (1 /=) $ concatMap (map length) mtx of
[] -> validate mtx
lens -> sep (minimum lens) [] (concat mtx)
sep _ lft [] = Left Nothing
sep _ lft ([]:xs) = Left Nothing
sep mx lft (is:xs) | length is == mx = Left $ Just $ map recov is
| otherwise = sep mx (lft ++ [is]) xs
where recov x = mtxify $ lft ++ [[x]] ++ xs
validate mtx
| and [all validateLn (f mtx) | f <- [blk,transpose,id]] = Right mtx
| otherwise = Left Nothing
where validateLn ln = sort (concat ln) == [1..9]
mtxify = unfoldr f
where f [] = Nothing
f xs = Just$ splitAt 9 xs
fill org = fixit $ (transpose . blk . cmp . blk . cmp . transpose . cmp) org
where fixit result | result == org = result
| otherwise = fill result
blk = unfoldr f
where f [] = Nothing
f ([]:[]:[]:d) = f d
f (a:b:c:d) = let (l,r) = unzip $ map (splitAt 3) [a,b,c] in
Just (concat l, r ++ d)
cmp = map (\x-> (unfoldr $ f $ concat $ filter ((==) 1 . length) x) x)
where f ones ([i]:is) = Just ([i],is)
f ones (i:is) = Just (i \\ ones,is)
f _ [] = Nothing
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment