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 ==  = (map (x:).factors' (x:xs))(div n x) ++ factors' xs n
| mod n x /=  = factors' xs n
proSumToK n = map ((uncurry (+)).(first((-)n)).f).factors$n
where f qs = (sum qs,genericLength qs)
proSum a k = findIndex f$[..]
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(,m)$map (S.fromList.proSumToK)$[..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 ==  = (map (x:).factors' (x:xs))(div n x) ++ factors' xs n
| mod n x /=  = 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,[],)
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つ減ったので、結構速くなった。