http://projecteuler.net/index.php?section=problems&id=185

Number Mindという問題らしい。

すなおに実装したら、解けなかった（計算量的な意味で）

そこで、数独と同じような感覚で実装。 

import Data.Array
import Data.List
import Data.Char
type Candidate = Array Int [Int]
type Guess = (Int,[Int])
type Mind = (Candidate,[Guess])
finish :: Mind -> Bool
finish (c,gs) = all unique' (elems c) && null gs
where unique' x = null (tail x) && x/=[10]
unfeasible :: Mind -> Bool
unfeasible (c,gs) = any ([10]==) (elems c) || any (not.active) gs
where active (k,ns) =  <=  k && k <= length (filter(/=10) ns)
fill :: Mind -> (Int,Int) -> Mind
fill (c,gs) (d+1,n) = (c//[(d+1,[n])],map fillG gs)
where fillG (k,ns) = let (xs,y:zs) = splitAt d ns
in if y == n
then (k-1,xs++10:zs)
else (k  ,xs++10:zs)
sieve :: Mind -> (Int,Int) -> Mind
sieve (c,gs) (d+1,n) = (c//[(d+1,delete n.(c!) $ d+1)],map sieveG gs)
where sieveG (k,ns) = let (xs,y:zs) = splitAt d ns
in if y == n
then (k,xs++10:zs)
else (k,xs++y:zs)
unique :: Candidate -> [(Int,Int)]
unique = map delT.filter((2==).length.snd).assocs
where delT (d,[n,10]) = (d,n)
solve :: [Mind] -> Integer
solve (m@(c,gs):ms) | finish m = read.map intToDigit.concat.elems $ c
| unfeasible m = solve ms
| unique c /= [] = solve $ foldl' fill m (unique c) : ms
| otherwise = solve $ step (c,sort gs) ++ ms
step :: Mind -> [Mind]
step (c,(k,ns):gs) = [foldl' fill (foldl' sieve (c,gs) (psp)) p | p <- comb ps k]
where ps = filter((10/=).snd).zip [1..] $ ns
comb _  = [[]]
comb [] _ = []
comb (x:xs) (n+1) = map (x:) (comb xs n) ++ comb xs (n+1)
main = print.solve.return $ (listArray (1,16).repeat $ [..10],guesses)
test = solve [(listArray (1,5).repeat $ [..10],sort sample)]
sample = [
(2,[9,,3,4,2]),
(,[7,,7,9,4]),
(2,[3,9,4,5,8]),
(1,[3,4,1,,9]),
(2,[5,1,5,4,5]),
(1,[1,2,5,3,1])]
guesses = [
(2,[5,6,1,6,1,8,5,6,5,,5,1,8,2,9,3]),
(1,[3,8,4,7,4,3,9,6,4,7,2,9,3,,4,7]),
(3,[5,8,5,5,4,6,2,9,4,,8,1,,5,8,7]),
(3,[9,7,4,2,8,5,5,5,,7,,6,8,3,5,3]),
(3,[4,2,9,6,8,4,9,6,4,3,6,,7,5,4,3]),
(1,[3,1,7,4,2,4,8,4,3,9,4,6,5,8,5,8]),
(2,[4,5,1,3,5,5,9,,9,4,1,4,6,1,1,7]),
(3,[7,8,9,,9,7,1,5,4,8,9,,8,,6,7]),
(1,[8,1,5,7,3,5,6,3,4,4,1,1,8,4,8,3]),
(2,[2,6,1,5,2,5,,7,4,4,3,8,6,8,9,9]),
(3,[8,6,9,,,9,5,8,5,1,5,2,6,2,5,4]),
(1,[6,3,7,5,7,1,1,9,1,5,,7,7,,5,]),
(1,[6,9,1,3,8,5,9,1,7,3,1,2,1,3,6,]),
(2,[6,4,4,2,8,8,9,,5,5,,4,2,7,6,8]),
(,[2,3,2,1,3,8,6,1,,4,3,,3,8,4,5]),
(2,[2,3,2,6,5,,9,4,7,1,2,7,1,4,4,8]),
(2,[5,2,5,1,5,8,3,3,7,9,6,4,4,3,2,2]),
(3,[1,7,4,8,2,7,,4,7,6,7,5,8,2,7,6]),
(1,[4,8,9,5,7,2,2,6,5,2,1,9,,3,,6]),
(3,[3,,4,1,6,3,1,1,1,7,2,2,4,6,3,5]),
(3,[1,8,4,1,2,3,6,4,5,4,3,2,4,5,8,9]),
(2,[2,6,5,9,8,6,2,6,3,7,3,1,6,8,6,7])]

解けた。