Problem 156

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

import Data.Char
import Data.List
count :: Int -> [Int] -> Integer
count d = genericLength.filter(==d)
listToInt :: [Int] -> Integer
listToInt = foldl' add 
where add a b = a*10+toInteger b
intToList,intToList' :: Integer -> [Int]
intToList = map digitToInt.show
intToList' = reverse. unfoldr f
where f  = Nothing
f n =let (q,r) = divMod n 10 in Just(fromIntegral r,q)
f d fix r = f' ((fix++).genericTake r.repeat $ ) d
f' [x] d | x < d = 
| otherwise = 1
f' (x:xs) d | x < d = g x k + f' xs d
| x == d = g x k + listToInt xs + 1 + f' xs d
| otherwise = g x k + 10^k + f' xs d
where k = length xs
g y m = (toInteger y)*(toInteger m*10^(m-1))
-- f(n,d) = n, n in X is not solvable ?
-- where X = {fix*10^r..fix*10^(r+1)-1}
-- i.e. n in {fix00..0,..,fix99..9}
unfeasible d fix r |  n > fnd = n - fnd > increase
| otherwise = fnd - n > decrease
where n = listToInt fix*10^r
fnd = f d fix r
m = count d fix
increase | m ==  = r*10^(r-1) + 9^r - 10^r
| otherwise = r*10^(r-1) + m*10^r
decrease | m /=  = 
| otherwise = 9^r
succ' (fix,r) | mod fix' 10 ==  = (intToList$ div fix' 10,r+1)
| otherwise = (intToList fix',r)
where fix' = succ.listToInt$ fix
pred' (fix,r) = (intToList.(*10).listToInt$ fix, r-1)
search d n@(fix,) | n' == f d fix  = n':search d (succ' n)
| otherwise = search d $ succ' n
where n' = listToInt fix
search d n@(fix,r) | r + genericLength fix > 11 = []
| unfeasible d fix r = search d $ succ' n
| otherwise = search d $ pred' n
main = print.sum.concatMap (d -> search d ([1],)) $ [1..9]

マジックナンバー11がいるが、気にしない。

（多分がんばれば正当性を示せる気がしないでもない。）

[追記]

各dについて不動点の存在範囲は(d+1)*10^11未満であることが分かった。

ポイントはK*10^(k-1)はk=10のときに10^10になること。

コンテンツ

[追記]