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) 
numToList :: Integral a => a -> [a]
numToList = reverse.unfoldr f
where f  = 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..],
d <- [12,15..48],
mod x d == ,
let q = numToList.div x $ d,
(numToList d ++ q)  [..9] == [],
any (z -> q!!(z+1)*d < 100) .findIndices (==).init $ q]

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

import Control.Monad.List

として 

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

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