+ day 21 (ft. failed 19, 20 attempts)
This commit is contained in:
parent
ce4e3c2c07
commit
e4aff2b447
|
@ -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
|
|
@ -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
|
|
@ -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
|
|
@ -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
|
Loading…
Reference in New Issue