Problem 170

http://projecteuler.net/index.php?section=problems&id=170
忙しいといいつつも。
合間にやってるだけだよ。と言い訳。
最大を探すので、9876543210から逆辞書式順に探索。
最初の数は3の倍数で50未満だと分かる。(10桁制約)
多分、解は98????????の形。
すると、整数は3つになり、はじめの1つは2桁。

import Data.List

permutation :: Eq a => [a] -> [[a]]
permutation [] = [[]]
permutation xs = [y:ys | y <- xs, ys <- permutation.delete y $ xs]

listToNum :: Num a => [a] -> a
listToNum = foldl (\a b-> 10*a+b) 0
numToList :: Integral a => a -> [a]
numToList = reverse.unfoldr f 
    where f 0 = Nothing
          f x = let (q,r) = divMod x 10 in Just (r,q)

main :: IO ()
main = print.head $
       [x | x <- map listToNum.permutation $ [9,8..0],
        d <- [12,15..48],
        mod x d == 0,
        let q = numToList.div x $ d,
        (numToList d ++ q) \\ [0..9] == [0],
        any (\z -> q!!(z+1)*d < 100) .findIndices (==0).init $ q]

ListTを使って途中経過を表示させると

import Control.Monad.List

として

p170 :: ListT IO Integer
p170 = do x <- liftList.map (listToNum.(9:).(8:)).permutation $ [7,6..0]
          d <- liftList [12,15..48]
          guard $ mod x d == 0
          let q = numToList.div x $ d
          guard $ (numToList d ++ q) \\ [0..9] == [0]
          liftIO.print $ (x,d,q)
          guard $ any (\z -> q!!(z+1)*d < 100) .findIndices (==0).init $ q
          return x

liftList :: (Monad m) => [a] -> ListT m a
liftList = msum.map return

main = print.head =<< runListT p170

しかし、この書き方では遅延評価がきかなかった。traceつかえば良い話ではあるが。