eldridge.cam
Advent of Code solutions
1import Control.Monad (guard)
2import Control.Monad.State
3import Data.Bits
4import Data.Bool
5import Data.Function ((&))
6import Data.List (find, foldl1, nub, sort, sortBy, sum)
7import Data.Map (Map, insert)
8import qualified Data.Map as Map
9import Data.Ord (comparing)
10import Text.Parsec (between, char, digit, many, many1, parse, sepBy1, sepEndBy, (<|>))
11
12integer = read <$> many digit
13
14machine = do
15 _ :: [Char] <- between (char '[') (char ']') $ many1 (char '.' <|> char '#')
16 char ' '
17 buttons :: [[Int]] <- (between (char '(') (char ')') $ integer `sepBy1` char ',') `sepEndBy` char ' '
18 joltage :: [Int] <- between (char '{') (char '}') $ integer `sepBy1` char ','
19 return $ (joltage, buttons)
20
21targetState '.' = False
22targetState '#' = True
23
24buttonBits len button = foldl setBit 0 $ map (\n -> len - n - 1) button
25
26decrAt 0 (m : ms) = m - 1 : ms
27decrAt i (m : ms) = m : decrAt (i - 1) ms
28
29applyButton target [] = target
30applyButton target (i : rest) = applyButton (decrAt i target) rest
31
32choose :: Int -> [a] -> [[a]]
33choose 0 _ = [[]]
34choose n [] = []
35choose n (x : xs) = ((x :) <$> choose (n - 1) xs) ++ choose n xs
36
37solveBits :: [[Int]] -> Int -> Int -> [[[Int]]]
38solveBits buttons len target =
39 [option | n <- [0 .. length buttons], option <- choose n buttons, target == (foldl xor 0 $ fmap (buttonBits len) option)]
40
41solve buttons joltage = evalState (solve_ joltage) Map.empty
42 where
43 solve_ :: [Int] -> State (Map [Int] Int) Int
44 solve_ joltage = do
45 cached <- gets (Map.lookup joltage)
46 case cached of
47 Nothing -> do
48 ans <- compute joltage
49 modify $ insert joltage ans
50 return ans
51 Just answer -> return answer
52 compute :: [Int] -> State (Map [Int] Int) Int
53 compute joltage =
54 if all (== 0) joltage
55 then return 0
56 else
57 joltage
58 & fmap (\n -> n `mod` 2)
59 & foldl (\joltage bit -> bit .|. joltage `shift` 1) 0
60 & solveBits buttons (length joltage)
61 & fmap (\sol -> (foldl applyButton joltage sol, length sol))
62 & filter (\(remaining, _) -> all (>= 0) remaining)
63 & mapM
64 ( \(remaining, score) -> do
65 sub <- solve_ (fmap (`div` 2) remaining)
66 return $ sub * 2 + score
67 )
68 & fmap (foldl min 10000000)
69
70answer input = sum $ fmap (\(j, b) -> solve b j) machines
71 where
72 Right machines = parse (machine `sepEndBy` char '\n') "" input
73
74main = getContents >>= print . answer