数独ソルバ

Haskell で数独ソルバを書いてみた。
特徴は
・明示的な再帰は使わず (iterate ...) !! 81 を使った。（８１手目に解が求まる）
・探索中のマス目状態を、未確定部分と仮確定部分に分けて持つ。

import List (partition,delete)

mark (pos@(i,j),d) cand = (cand1++) $ filter (not.null.snd) $ map del cand2 where
  (cand1,cand2) = partition p cand
  p ((k,l),_) = k /= i && l /= j && map (`div`3) [k,l] /= ij0
  ij0 = map (`div`3) [i,j]
  del (pos',ds) = (pos', if pos'==pos then [] else delete d ds)

ixs = [0..8]

solve nss = [[[n| j <- ixs, Just n <- [lookup (i,j) ds]]| i <- ixs]| (_,ds) <- ss] where
  ss = (!!81) $ iterate (>>=f) [(iniCand,[])]
  iniCand = [((i,j),ds)| i <- ixs, j <- ixs,
    let n = nss!!i!!j, let ds = if n==0 then [1..9] else [n]]
  f ([],_) = []
  f (cand,ds) = [(mark pn cand, pn:ds)|
    let (pos,ns) = snd $ minimum $ map (\x -> (length $ snd x, x)) cand,
    n <- ns, let pn = (pos,n)]

sample = [
  [8,0,0,0,3,4,0,5,0],
  [0,0,2,0,0,0,0,0,1],
  [0,1,0,9,0,0,0,0,0],
  [0,0,8,0,0,9,0,0,6],
  [5,0,0,0,1,0,0,0,8],
  [6,0,0,4,0,0,7,0,0],
  [0,0,0,0,0,1,0,7,0],
  [2,0,0,0,0,0,1,0,0],
  [0,9,0,5,6,0,0,0,2]]

として

> mapM_ ((>>putStr"\n").mapM_ print) $ solve sample
[8,6,7,1,3,4,2,5,9]
[9,5,2,6,7,8,3,4,1]
[4,1,3,9,5,2,6,8,7]
[7,4,8,3,2,9,5,1,6]
[5,3,9,7,1,6,4,2,8]
[6,2,1,4,8,5,7,9,3]
[3,8,6,2,4,1,9,7,5]
[2,7,5,8,9,3,1,6,4]
[1,9,4,5,6,7,8,3,2]

http://www.haskell.org/haskellwiki/Sudoku を見たらいろんな数独ソルバが載っていた。