+ day 21 (ft. failed 19, 20 attempts)

19-a.hs

@@ -0,0 +1,67 @@
+{-# LANGUAGE InstanceSigs #-}
+import Common
+-- not to be confused with AStar.hs! that one was bugged :)
+import Data.Graph.AStar
+import Data.List.Split (splitOn)
+import Data.List (elemIndex)
+import Data.Maybe (fromJust, mapMaybe)
+import qualified Data.Map.Strict as M
+import Data.Map.Strict (Map, (!))
+import qualified Data.HashSet as HS
+import Data.HashSet (HashSet)
+import Data.Hashable (Hashable (hash, hashWithSalt))
+import Data.Bits
+
+data Material = Ore | Clay | Obsidian | Geode
+  deriving (Eq, Show)
+
+newtype Robot = Robot Material
+  deriving (Eq, Show)
+
+data Recipe = Recipe [(Int, Material)] Robot
+  deriving (Eq, Show)
+
+type Blueprint = [Recipe]
+
+parseMaterial :: String -> Material
+parseMaterial "ore" = Ore
+parseMaterial "clay" = Clay
+parseMaterial "obsidian" = Obsidian
+parseMaterial "geode" = Geode
+parseMaterial _ = undefined
+
+parseRecipe :: String -> Maybe Recipe
+parseRecipe s = do
+  let split = words s
+  typeIndex <- elemIndex "Each" split
+  recipeIndex <- elemIndex "costs" split
+  let ingredients = map ((\[a, b] -> (read a, parseMaterial b)) . words . trim) $ splitOn "and" $ unwords $ drop (recipeIndex + 1) split
+  let robotType = parseMaterial $ split !! (typeIndex + 1)
+  return $ Recipe ingredients (Robot robotType)
+
+parse :: String -> [Recipe]
+parse s = mapMaybe parseRecipe recipes
+  where
+    recipes = map trim $ splitOn "." s
+
+newtype State = State (Map Material Int, Map Robot Int, Int)
+  deriving (Eq)
+
+-- for Some reason hashable doesn't export these. Cool :)
+hashInt s x = (s * 16777619) `xor` x
+defaultHashWithSalt salt x = salt `hashInt` hash x
+
+instance Hashable State where
+  hash :: State -> Int
+  hash (State (materials, robots, minute)) = foldr hashInt minute (M.elems materials ++ M.elems robots)
+
+  hashWithSalt :: Int -> State -> Int
+  hashWithSalt = defaultHashWithSalt
+
+nextNodes :: Blueprint -> State -> HashSet State
+nextNodes recipes s = set
+  where set = HS.fromList [s]
+
+main = interact $
+  show
+  . map parse . lines

20-a.hs

@@ -0,0 +1,36 @@
+import Common
+import Data.List (elemIndex)
+import Data.Maybe (fromJust)
+
+wrap :: Int -> Int -> Int
+wrap length index
+  | index == 0 = length - 1
+  | index == length - 1 = 0
+  | index >= length = wrap length $ index - length
+  | index < 0 = wrap length $ index + length
+  | otherwise = index
+
+coordinates = [1000, 2000, 3000]
+
+decrypt :: [Int] -> Int
+decrypt a = sum $ map test coordinates
+  where
+    test n = mixed !! (zeroIndex + n)
+    zeroIndex = fromJust $ elemIndex 0 mixed
+    mixed = cycle $ foldl mix a a
+
+    len = length a
+
+    mix :: [Int] -> Int -> [Int]
+    mix list x = newList
+      where
+        newList = listStart ++ x : listEnd
+        (listStart, listEnd) = splitAt newIndex list'
+        newIndex = wrap (len - 1) $ oldIndex + x
+        list' = filter (/= x) list
+        oldIndex = fromJust $ elemIndex x list
+
+main = interact $
+  show
+  . decrypt
+  . map read . lines

21-a.hs

@@ -0,0 +1,52 @@
+import Common
+import qualified Data.Map as M
+import Data.Function.Memoize (Memoizable(memoize))
+
+type Monkey = String
+
+data Operation = Const Int | Add Monkey Monkey | Sub Monkey Monkey | Mult Monkey Monkey | Div Monkey Monkey
+  deriving (Show, Eq)
+
+charToOp '+' = Add
+charToOp '-' = Sub
+charToOp '*' = Mult
+charToOp '/' = Div
+charToOp c = error $ "unknown op " ++ [c]
+
+parseOp :: String -> Operation
+parseOp str
+  | length s == 1 = Const $ read str
+  | length s == 3 = op (s !! 0) (s !! 2)
+  | otherwise = error $ "can't parse op " ++ str
+  where
+    s = words str
+    op = charToOp $ head $ s !! 1
+
+parseLine :: String -> (Monkey, Operation)
+parseLine s = (name, op)
+  where
+    op = parseOp $ trim $ tail opS
+    (name, opS) = splitAt 4 s
+
+rootMonkey :: Monkey
+rootMonkey = "root"
+
+eval :: M.Map Monkey Operation -> Int
+eval monkeys = evalMonkey' rootMonkey
+  where
+    evalMonkey' = memoize evalMonkey
+
+    evalMonkey :: String -> Int
+    evalMonkey m = case op of
+      Const n -> n
+      Add a b -> evalMonkey' a + evalMonkey' b
+      Sub a b -> evalMonkey' a - evalMonkey' b
+      Mult a b -> evalMonkey' a * evalMonkey' b
+      Div a b -> evalMonkey' a `div` evalMonkey' b
+      where
+        op = (M.!) monkeys m
+
+main = interact $
+  show
+  . eval
+  . M.fromList . map parseLine . lines

21-b.hs

@@ -0,0 +1,93 @@
+import Common
+import qualified Data.Map as M
+import Data.Function.Memoize (Memoizable(memoize))
+import Data.Maybe (fromJust)
+
+type Monkey = String
+
+data Operation = Const Int | Add Monkey Monkey | Sub Monkey Monkey | Mult Monkey Monkey | Div Monkey Monkey
+  deriving (Show, Eq)
+
+charToOp '+' = Add
+charToOp '-' = Sub
+charToOp '*' = Mult
+charToOp '/' = Div
+charToOp c = error $ "unknown op " ++ [c]
+
+getBranches :: Operation -> Maybe (Monkey, Monkey)
+getBranches (Const _) = Nothing
+getBranches (Add a b) = Just (a, b)
+getBranches (Sub a b) = Just (a, b)
+getBranches (Mult a b) = Just (a, b)
+getBranches (Div a b) = Just (a, b)
+
+parseOp :: String -> Operation
+parseOp str
+  | length s == 1 = Const $ read str
+  | length s == 3 = op (s !! 0) (s !! 2)
+  | otherwise = error $ "can't parse op " ++ str
+  where
+    s = words str
+    op = charToOp $ head $ s !! 1
+
+parseLine :: String -> (Monkey, Operation)
+parseLine s = (name, op)
+  where
+    op = parseOp $ trim $ tail opS
+    (name, opS) = splitAt 4 s
+
+rootMonkey :: Monkey
+rootMonkey = "root"
+human :: Monkey
+human = "humn"
+
+eval :: M.Map Monkey Operation -> Int
+eval monkeys = getInput humanBranch targetResult
+  where
+    getInput m n = case monkey of
+      -- a + b = n
+      Add a b -> if lHuman then getInput a (n - evalMonkey' b) else getInput b (n - evalMonkey' a)
+      -- a - b = n
+      Sub a b -> if lHuman then getInput a (n + evalMonkey' b) else getInput b (evalMonkey' a - n)
+      -- a * b = n
+      Mult a b -> if lHuman then getInput a (n `div` evalMonkey' b) else getInput b (n `div` evalMonkey' a)
+      -- a / b = n
+      Div a b -> if lHuman then getInput a (n * evalMonkey' b) else getInput b (evalMonkey' a `div` n)
+      Const _ -> n
+      where
+        lHuman = hasHuman' branchL
+        (branchL, branchR) = fromJust $ getBranches $ (M.!) monkeys m
+        monkey = (M.!) monkeys m
+
+    targetResult = evalMonkey' resolvedBranch
+
+    resolvedBranch = if hasHuman' rootBranchL then rootBranchR else rootBranchL
+    humanBranch = if hasHuman' rootBranchL then rootBranchL else rootBranchR
+
+    (rootBranchL, rootBranchR) = fromJust $ getBranches $ (M.!) monkeys rootMonkey
+
+    hasHuman' = memoize hasHuman
+
+    hasHuman :: Monkey -> Bool
+    hasHuman m 
+      | m == human = True
+      | otherwise = case getBranches $ (M.!) monkeys m of
+        Just (a, b) -> hasHuman' a || hasHuman' b
+        Nothing -> False
+
+    evalMonkey' = memoize evalMonkey
+
+    evalMonkey :: String -> Int
+    evalMonkey m = case op of
+      Const n -> n
+      Add a b -> evalMonkey' a + evalMonkey' b
+      Sub a b -> evalMonkey' a - evalMonkey' b
+      Mult a b -> evalMonkey' a * evalMonkey' b
+      Div a b -> evalMonkey' a `div` evalMonkey' b
+      where
+        op = (M.!) monkeys m
+
+main = interact $
+  show
+  . eval
+  . M.fromList . map parseLine . lines