Problem 201

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 ((0,0), (div n 2,u)) 0 :: ST s (STUArray s (Int, Int) Int)
            writeArray memo (0,0) 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 0
main :: IO ()
main = print.runST $ p201 100

速くないし、手続き型のようだ。
配列要素はIntである必要はない。0、1、それ以上が区別できれば良い。
だけど、面倒。