1 files changed, 29 insertions(+), 14 deletions(-)

M 2015/24.hs

@@ 30,29 30,44 @@ pick n [] = []
 pick 1 (x:xs) = [x]:pick 1 xs
 pick n (x:xs) = (fmap ((:) x) (pick (pred n) xs)) `combine` (pick n xs)
 
+qe ws = foldl' (*) 1 ws
+
+partition :: Int -> [Int] -> Maybe [[Int]]
+partition gs ws = go 1
+  where go n = case pick n ws of
+                 [] -> Nothing
+                 ps -> case filter ((==) gs . sum) ps of
+                         [] -> go (succ n)
+                         qs -> Just qs
+
 partA :: [Int] -> Int
 partA ws = search 0
   where groupSum = sum ws `div` 3
-        qe ws = foldl' (*) 1 ws
         search n = case candidates n of
                      [] -> search (succ n)
                      cs -> minimum cs
         candidates n = catMaybes $ fmap checkBalance $ filter ((==) groupSum . sum) $ pick n ws
-        checkBalance qs = let ws' = ws \\ qs in
-                          let go n = case pick n ws' of
-                                       [] -> False
-                                       qs' -> case filter ((==) groupSum . sum) qs' of
-                                                [] -> go (succ n)
-                                                (_:_) -> True in
-                          if go 1 then Just (qe qs)
-                                  else Nothing
-
---partB :: Parse -> Parse
---partB = id
+        checkBalance qs = case partition groupSum (ws \\ qs) of
+                            Just _ -> Just $ qe qs
+                            Nothing -> Nothing
+
+partB :: [Int] -> Int
+partB ws = search 0
+  where groupSum = sum ws `div` 4
+        search n = case candidates n of
+                     [] -> search (succ n)
+                     cs -> minimum cs
+        candidates n = catMaybes $ fmap checkBalance $ filter ((==) groupSum . sum) $ pick n ws
+        checkBalance qs = let ws' = (ws \\ qs) in
+                          case partition groupSum ws' of
+                            Nothing -> Nothing
+                            Just qs' -> case catMaybes $ fmap (partition groupSum . (\\) ws') qs' of
+                                          [] -> Nothing
+                                          (_:_) -> Just $ qe qs
 
 main :: IO ()
 main = with parser $ do
   run' "24.example" "a example" partA 99
   run' "24.input" "a input" partA 11846773891
-  --run "24.example" "b example" partB
-  --run "24.input" "b input" partB
+  run' "24.example" "b example" partB 44
+  run' "24.input" "b input" partB 80393059