~rootmos/AoC

0d911bd267ff05ceaf8094158e2a02574a8103c7 — Gustav Behm 1 year, 4 months ago 848f0c1
Add solution to AoC 2015 #24b
1 files changed, 29 insertions(+), 14 deletions(-)

M 2015/24.hs
M 2015/24.hs => 2015/24.hs +29 -14
@@ 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