Life Goes On

まあまあだけど楽しんでる方です

105問目

http://projecteuler.net/index.php?section=problems&id=105
103問目の関連問題。
大きさ n の集合 A の要素の和を S(A) とおく。空でなく共通の要素を持たない2つの部分集合 B, C が、以下の性質を持つような集合を特別な集合と呼ぶ。

  1. S(B) ≠ S(C); つまり、部分集合の和は等しくない。
  2. B が C より多くの要素を持つならば S(B) > S(C)

与えられた集合の中の特別な集合 A を全て求め、その S(A) の総和を答える。
106問目を先に解いて、1つめの性質はそれを利用しています。
2つめの性質については、例えば n = 7, 8 のとき、小さい要素 4 つと大きい要素 3 つを比べれば十分という点に着目して計算量を減らしています。
あと、(\ (a, b) -> a > b) が長ったらしくて嫌だなぁと思っていたのですが、こちらを見て、自分が意味のない uncurry をしていたことに気付きました。

import Data.List

main = print . sum . map sum . filter euler105
    . map (read . ("[" ++) . (++ "]")) . lines =<< readFile "sets.txt"

euler105 :: [Int] -> Bool
euler105 set = prop2 set && prop1 set

prop2 :: [Int] -> Bool
prop2 set = (sum $ take (q + r) $ sort set) > (sum $ drop (q + 1) $ sort set)
    where (q, r) = divMod (length set) 2

prop1 :: [Int] -> Bool
prop1 set = all (\ (as, bs) -> sum as /= sum bs)
    $ concat [ pair set n | n <- [2..(div (length set) 2)] ]

pair :: [Int] -> Int -> [([Int], [Int])]
pair xs n = [ (as, bs) | as <- comb xs n, bs <- comb (xs \\ as) n,
    as < bs, or $ zipWith (>) as bs ]
--  as < bs, any (\ (a, b) -> a > b) $ zip as bs ]

comb :: Ord a => [a] -> Int -> [[a]]
comb xs 0 = [[]]
comb xs m = [ x : xs' | x <- xs, xs' <- comb (filter (> x) xs) (m - 1) ]