201 Subsets with a unique sum

Problem 201 – Project Euler

特別な集合だから、賢い解法があるのかとも思ったけど、

思いつかなかった。

こういう、問題はDPがほとんど。

問題はどうDPを構成するか。

多分、二通りあって、何個とるか、と何個からとるか。

何個とるか、は複雑で良く分からない。

結局、何個から取るかで、やった。 

{-# OPTIONS_GHC -XBangPatterns #-}
import Control.Monad (when)
import Data.Array.ST (STUArray, newArray, readArray, writeArray)
import Control.Monad.ST (ST, runST)
p201 :: Int -> ST s Int
p201 n = do let u = sum.take (div n 2).reverse.map (^2) $ [1..n]
memo <- newArray ((,), (div n 2,u))  :: ST s (STUArray s (Int, Int) Int)
writeArray memo (,) 1
let loop1 !i = when (i<=n) $ loop2 (i*i) (div n 2) >> loop1 (i+1)
loop2 !i2 !j = when (1<=j) $ put i2 j i2 >> loop2 i2 (j-1)
put !i2 !j !k =
when (k<=u) $
do v <- readArray memo (j-1,k-i2)
readArray memo (j,k) >>= writeArray memo (j,k).(v+)
put i2 j (k+1)
sumUnique !i !s | i > u    = return s
| otherwise =
do v <- readArray memo (div n 2,i)
if v == 1 then sumUnique (i+1) (s+i)
else sumUnique (i+1) s
loop1 1
sumUnique 1 
main :: IO ()
main = print.runST $ p201 100

速くないし、手続き型のようだ。

配列要素はIntである必要はない。0、1、それ以上が区別できれば良い。

だけど、面倒。