Haskellで100マス計算と数独を解いてみた

Haskell学習のために100マス計算と数独を解いてみました。

100マス計算

module Try.Hyakumasu where

data MathData = MathData {col :: [Int], row :: [Int]} deriving (Show, Eq)

hyakumasu :: (Int -> Int -> Int) -> MathData -> [[Int]]
hyakumasu f x = [mathList f c (col x) | c <- (row x)]

mathList :: (Int -> Int -> Int) -> Int -> [Int] -> [Int]
mathList f a x = f a <$> x

printMath :: (Int -> Int -> Int) -> MathData -> IO ()
printMath f a = do
    mapM_ listPrint $ [[0] ++ col a] ++ zipWith (\a b -> [a] ++ b) (row a) (hyakumasu  f a )

listPrint :: [Int] -> IO ()
listPrint a = print $  concat $ map (\x ->  concat [" " | c <- [1..(4 - length (show x))]] ++ show x) a

main = do
     printMath (*) $ MathData [1,2,3] [4,5,6]

100マス計算はとりあえずこれで動くかと思います。計算対象となる行と列の値は専用のデータ型MathDataを使っています。mathListはInt型同士で計算を行う関数とInt型とInt型のリストを受け取って演算結果のInt型のリストを返しています。hyakumasuはMathDataのcolとrowの要素であるInt型のリストに対してmathListの計算を実行します。計算自体はこれだけで完了していまして、短くしようと思ったら関数一つにもまとめられるかと思います。Int型のリスト同士に関数を適用後にInt型を返す方法を探してみたのですが、良い方法が思い浮かばなかったのでとりあえずList内包表記で実現しています。計算結果の表示にはprintMath関数を使っていますが、整形して表示するためにcol, row, 計算結果のリストを連結させています。

数独

module Try.Sudoku where

import Data.List
import Data.Function

type Cell = (Int, Int)
type Board = [(Cell, Int)]

solve :: Board -> [Board]
solve board | length board == 81 = [board]
solve board = do
    concat $ map solve [ (cell, n) : board
                        | let remains = concat $ (\x -> if x `elem` map (\x -> fst x) board then [] else [x]) <$> cells
                        , let cell = maximumBy (compare `on` length . used board) remains
                        , n <- concat $ (\x -> if x `elem` used board cell then [] else [x]) <$> [1..9]]


cells :: [Cell]
cells = [(x, y) | x <- [0..8], y <- [0..8]]

area :: Cell -> Int
area (x, y) = y `div` 3 * 3 + x `div` 3

used :: Board -> Cell -> [Int]
used board cell = nub [ n
                      | (cell', n) <- board
                      , any (\f -> f cell == f cell') [snd, fst, area]
                      ]

format :: Board -> [[Int]]
format = map (map snd) . transpose . groupBy ((==) `on` (fst . fst)) . sort

problem :: Board
problem = [ ((3, 0), 8),
            ((5, 0), 1),
            ((6, 1), 4),
            ((7, 1), 3),
            ((0, 2), 5),
            ((4, 3), 6),
            ((6, 3), 8),
            ((6, 4), 1),
            ((1, 5), 2),
            ((4, 5), 3),
            ((0, 6), 6),
            ((7, 6), 7),
            ((8, 6), 5),
            ((2, 7), 3),
            ((3, 7), 4),
            ((3, 8), 2),
            ((6, 8), 6)
            ]  

sudokuAns :: IO ()
sudokuAns = case solve problem of
    answer : _ -> mapM_ print $ format answer
    []         -> putStrLn "invalid problem"

main = do
    print "main start"
    sudokuAns

数独の計算もこれだけで簡潔にかけるようです。数独の計算に使うデータ型としてマスを表すCellとマスと値の組み合わせて板全体の情報を表すBoardを使っています。それぞれの関数についてまずcellsは板状の全てのマスをリストにして返します。areaは対象のますが3*3のどの位置になるかを返します。usedは対象のマスと版全体の情報を元にそのマスではすでに使用済みとなっていて使えない数値のリストを返します。それからsolveでは受け取ったBoardが埋まり切っていたら答えとして返し、それ以外であればリスト内包表記を使い、余っているマス(埋まっている順で選ぶ)と余っている数値の組み合わせをBoardに連結してBoardが埋まりきるまで再帰的にsolveを呼び出すというふうにしています。filterの仕方はもうちょっと上手い方法がありそう。