# Advent of Code 2022 day 21

Day 21 was something we've not fully seen before this year: the evaluation of expressions. It also gave me an excuse to experiment with the index lens operations like at. I'm not sure they added much to this example.

## Data structures

The data was a pretty direct translation from the problem: a monkey can Shout a number, or shout some combination of other monkeys' shouts. The group of monkeys is represented as a Map from monkey name to Shout.

Parsing the monkeys is long, to account for the nested structures and options.

data Shout = Literal Int | Operation Operator String String
deriving (Show, Eq, Ord)

data Operator = Plus | Minus | Times | Divide
deriving (Show, Eq, Ord)

type Monkeys = M.Map String Shout

fromLiteral :: Shout -> Int
fromLiteral (Literal n) = n
fromLiteral _ = error "fromLiteral"

monkeysP = M.fromList <$> monkeyP sepBy endOfLine monkeyP = (,) <$> (nameP <* ": ") <*> shoutP
shoutP = numberP <|> operationP
numberP = Literal <$> decimal operationP = opify <$> nameP <*> operatorP <*> nameP
where opify l o r = Operation o l r
nameP = many1 letter
operatorP = plusP <|> minusP <|> timesP <|> divideP
plusP = Plus   <$" + " minusP = Minus <$ " - "
timesP = Times  <$" * " divideP = Divide <$ " / "

## Evaluating monkeys

The basic idea is to split the monkeys into two groups: those that can shout a literal number, and those that need to work out what to say (called values and operations below).

splitMonkeys :: Monkeys -> (Monkeys, Monkeys)
splitMonkeys = M.partition f
where f (Literal _) = True
f (Operation _ _ _) = False

Then, I can go through all the monkeys with operations and, one by one, check if all the monkeys they need are ones with values. If this monkey can now shout a number, I add that monkey/number to the the values and remove it from the operations. If not, that monkey is added to a new set of pending operations.

evaluateMonkeys :: Monkeys -> Monkeys -> (Monkeys, Monkeys)
evaluateMonkeys values operations = M.foldlWithKey' f ((values, M.empty)) operations
where f (valMs, opMs) name op =
case (evalShout valMs op) of
Nothing -> (valMs, opMs & at name ?~ op)
Just v -> (valMs & at name ?~ v, sans name opMs)

I use Applicatives to find the value of a Shout, returning Nothing if the monkey can't shout yet, or Just (Literal n) if it can shout a number.

evalShout :: Monkeys -> Shout -> Maybe Shout
evalShout _ (Literal n) = Just $Literal n evalShout values (Operation op l r) = apply <$> (Just op) <*> lval <*> rval
where lval = M.lookup l values
rval = M.lookup r values

apply :: Operator -> Shout -> Shout -> Shout
apply Plus (Literal l) (Literal r) = Literal (l + r)
apply Minus (Literal l) (Literal r) = Literal (l - r)
apply Times (Literal l) (Literal r) = Literal (l * r)
apply Divide (Literal l) (Literal r) = Literal (l div r)
apply _ _ _ = error "Illegal apply"

I find the value of "root" by repeating evaluateMonkeys until "root" has a value. (There may be a few monkeys that will never shout a value: I don't know, I didn't check.)

findRoot :: Monkeys -> Monkeys -> Shout
findRoot values operations
| "root" M.member values = values ! "root"
| otherwise = findRoot values' operations'
where (values', operations') = evaluateMonkeys values operations

part1 :: Monkeys -> Int
part1 monkeys = fromLiteral $findRoot values operations where (values, operations) = splitMonkeys monkeys ## Finding what to shout For part 2, I changed the operation of "root" to be Minus. If the two operands were equal, "root" would shout zero. I then had to find a value to make that true, using non-zero values as clues. A bit of poking around, using the trial function, showed that small values of "humn" gave large values of "root", and increasing the values of "humn" gave smaller values of "root". I hard-coded that behaviour into the search (meaning that my code doesn't work on the example). trial :: Monkeys -> Monkeys -> Int -> Shout trial values operations humn = findRoot (values & at "humn" ?~ (Literal humn)) operations First was to find a range of values of "humn" to search. I started at 1 and kept doubling it until "root" changed from positive to negative. findRange :: Monkeys -> Monkeys -> Int -> (Int, Int) findRange values operations prev | res > 0 = findRange values operations (prev * 2) | otherwise = (prev, prev * 2) where res = fromLiteral$ trial values operations (prev * 2)

Given a range of values where the value of "root" changed from positive to negative, I then used a binary search to find the value of "humn" that gave zero for "root".

part2 monkeys = binarySearch values operations l u
where (Operation _ rootL rootR) = monkeys ! "root"
monkeys' = monkeys & at "root" ?~ (Operation Minus rootL rootR)
(values, operations) = splitMonkeys monkeys'
(l, u) = findRange values operations 1

binarySearch :: Monkeys -> Monkeys -> Int -> Int -> Int
binarySearch values operations lower upper
| lower > upper = error "Failed search"
| result == 0 = probe
| result > 0 = binarySearch values operations (probe + 1) upper
| result < 0 = binarySearch values operations lower probe
where probe = ((upper - lower) div 2) + lower
result = fromLiteral \$ trial values operations probe


## Code

You can get the code from my locally-hosted Git repo, or from Gitlab.