Problem 88

http://projecteuler.net/index.php?section=problems&id=88
調べる範囲が2~12000なので、product-sumの値は高々20000だとした。実際そうだった。
あまり速くない。やはり、Arrayはあまり速くないのか？

import Data.List
import qualified Data.Set as S
import Data.Maybe
import Control.Arrow
import Data.Array.IArray
factors  = factors' [2..]
factors' (x:xs) n | n < x*x = [[n]]
                  | mod n x == 0 = (map (x:).factors' (x:xs))(div n x) ++ factors' xs n
                  | mod n x /= 0 = factors' xs n

proSumToK n = map ((uncurry (+)).(first((-)n)).f).factors$n
    where f qs = (sum qs,genericLength qs)

proSum a k = findIndex f$[0..]
    where f n = S.member k .(a!)$n

proSums a k = S.toList.S.fromList.catMaybes.map (proSum a)$ [2..k]

proSumToKArray :: Integer -> Array Integer (S.Set Integer)
proSumToKArray m = listArray(0,m)$map (S.fromList.proSumToK)$[0..m]

main =print.sum.proSums (proSumToKArray 20000)$12000

Setを使ってみた。

import Data.List
import qualified Data.Set as S

factors  = factors' [2..]
factors' (x:xs) n | n < x*x = [[n]]
                  | mod n x == 0 = (map (x:).factors' (x:xs))(div n x) ++ factors' xs n
                  | mod n x /= 0 = factors' xs n

proSumToK n = map (\ x->n-sum x+genericLength x).factors$n

update k (s,ns,n) = foldl insert' (s,ns,n+1) .filter need .proSumToK $n
    where need x = 1<=x && x<=k && S.notMember x s
          insert'(t,ms,m) k = (S.insert k t,add n ms,m)
          add x (y:ys) | x==y = y:ys
                       | x/=y = x:y:ys

p088 k = sum.second.until allIn (update k)$(S.empty,[0],0)
    where first (a,b,c) = a
          second (a,b,c) = b
          allIn =(==k).S.size.first
main = print.p088$12000

イメージとしてはproduct-sum=n (0,1,2..) でできるkをどんどんSetに突っ込んでSetにほしいものが全部入ったら終了。
サーチが1つ減ったので、結構速くなった。