Day 21 - Variable Tree Solving

Solution code on GitHub

All 2022 Problems

Subscribe to Monday Morning Haskell!

Problem Overview

Full Description

In today's problem, we're effectively analyzing a variable tree. Some lines we'll read will contain constant values. Others depend on the results of other lines and perform operations. In the first part, we just have to work our way down the call tree to determine the appropriate final value.

In the second part, we have to be a bit more clever. The root operation expects equality between its two values. And we're responsible for determining the value of one of the variables (humn) such that the equality is true.

Throughout this problem, we're going to assume that the variables do, in fact, form a proper tree. That is, each variable has at most one parent that relies upon its value. If the humn variable we eventually fill in ends up on both sides of an equation, things would get a lot more complicated, but it turns out this never happens.

Solution Approach and Insights

Recursion works very nicely and gives us a compact solution, especially for Day 1. I started off keeping track of more things like the dependency mapping between variable names because I thought it might help performance. But once I saw the inputs are just a tree, I realized it was unnecessary.

Parsing the Input

Our input gives a variable name on each line, and then some kind of calculation. This can either be a constant number (they're all positive integers) or it can have two other variable names with an operation (+, -, *, /).

root: pppw + sjmn
dbpl: 5
cczh: sllz + lgvd
zczc: 2
ptdq: humn - dvpt
dvpt: 3
lfqf: 4
humn: 5
ljgn: 2
sjmn: drzm * dbpl
sllz: 4
pppw: cczh / lfqf
lgvd: ljgn * ptdq
drzm: hmdt - zczc
hmdt: 32

To represent these values, let's first define a type for operations (the Equals operation doesn't appear in the input, but it will come into play for part 2).

data Op =
  Plus |
  Minus |
  Times |
  Divided |
  Equals
  deriving (Show, Eq)

Now we'll define a Calculation type for the contents of each line. This is either a constant (FinalValue) or it is an Operation containing two strings and the Op constructor (we never have an operation with a string and a constant). As with Equals, we'll understand the meaning of HumanVal in part 2.

data Calculation =
  FinalValue Int64 |
  Operation Op String String |
  HumanVal
  deriving (Show, Eq)

First let's parse an Op:

parseOp :: (MonadLogger m) => ParsecT Void Text m Op
parseOp =
  (char '+' >> return Plus) <|>
  (char '-' >> return Minus) <|>
  (char '*' >> return Times) <|>
  (char '/' >> return Divided)

Then we can use this to parse the full Calculation for an operation involving two variables.

parseOpNode :: (MonadLogger m) => ParsecT Void Text m Calculation
parseOpNode = do
  s1 <- some letterChar
  char ' '
  op <- parseOp
  char ' '
  s2 <- some letterChar
  return $ Operation op s1 s2

Then using an alternative between this operation parser and a standard integer, we can parse the complete line, including the string.

type LineType = (String, Calculation)

parseLine :: (MonadLogger m) => ParsecT Void Text m LineType
parseLine = do
  name <- some letterChar
  string ": "
  calc <- parseFinalValue <|> parseOpNode
  return (name, calc)
  where
    parseFinalValue = FinalValue . fromIntegral <$> parsePositiveNumber

And now we'll turn all our lines into a HashMap for easy access.

type CalculationMap = HM.HashMap String Calculation
type InputType = CalculationMap

parseInput :: (MonadLogger m) => ParsecT Void Text m InputType
parseInput = HM.fromList <$> sepEndBy1 parseLine eol

Part 1

The first part is quite simple if we're familiar with recursion! We mainly want a function to solve a single String variable based on the calculation map. If this variable depends on other variables, we'll recursively calculate their values first, and combine them with the operation.

We'll start with a couple base cases. A FinalValue will simply return its constant. And then we'll fail if this function is called with a HumanVal. We'll see how that gets handled in part 2.

solveValue :: (MonadLogger m, MonadFail m) => CalculationMap -> String -> m Int64
solveValue calculationMap name = case calculationMap HM.! name of
  (FinalValue x) -> return x
  HumanVal -> fail "Can't solve human value! Check with hasHumanVal first."
  (Operation op s1 s2) -> = ...

Now we'll make the recursive calls on the string values in the operation, and combine them in the way specified. All numbers are integers, so quot is the proper kind of division.

solveValue :: (MonadLogger m, MonadFail m) => CalculationMap -> String -> m Int64
solveValue calculationMap name = case calculationMap HM.! name of
  (FinalValue x) -> return x
  HumanVal -> fail "Can't solve human value! Check with hasHumanVal first."
  (Operation op s1 s2) -> do
    x1 <- solveValue calculationMap s1
    x2 <- solveValue calculationMap s2
    case op of
      Plus -> return $ x1 + x2
      Minus -> return $ x1 - x2
      Times -> return $ x1 * x2
      Divided -> return $ x1 `quot` x2
      Equals -> if x1 == x2 then return 1 else return 0

Our implementation for Equals is arbitrary...this function shouldn't be used on any Equals operations.

Now to tie the solution together, we just call solveValue with root and we're already done!

type EasySolutionType = Int64

processInputEasy :: (MonadFail m, MonadLogger m) => InputType -> m EasySolutionType
processInputEasy calculationMap = solveValue calculationMap "root"

solveEasy :: FilePath -> IO (Maybe Int64)
solveEasy fp = runStdoutLoggingT $ do
  input <- parseFile parseInput fp
  Just <$> processInputEasy input

Part 2

Now we have a different challenge in Part 2. The root operation automatically becomes an Equals operation. So we expect that the two variables (pppw and sjmn in the above example) ultimately have equal values. The trick is we have to select the value for the "human" variable humn (discarding its original value of 5) such that these two end up equal to each other. We can start by updating our calculation map to make these two changes:

updateCalculationsHard :: (MonadLogger m, MonadFail m) => CalculationMap -> m CalculationMap
updateCalculationsHard calculationMap = do
  let map' = HM.insert "humn" HumanVal calculationMap
  case HM.lookup "root" calculationMap of
    Nothing -> fail "Error! Must have root!"
    Just (FinalValue x) -> fail "Error! Root cannot be final!"
    Just HumanVal -> fail "Error! Root cannot be human!"
    Just (Operation _ s1 s2) -> return $ HM.insert "root" (Operation Equals s1 s2) map'

Now, because we're assuming a tree structure, whenever we encounter an operation of two variables, we assume only one of them depends on the humn variable. To determine which, we'll write a function hasHumanDep to check if the particular variable depends on the human value. Of course, in the base cases, a HumanVal returns True while a FinalValue returns False.

hasHumanDep :: (MonadLogger m) => CalculationMap -> String -> m Bool
hasHumanDep calculationMap nodeName = case calculationMap HM.! nodeName of
  HumanVal -> return True
  (FinalValue _) -> return False
  ...

For operations, we simply look recursively at both sub-elements and "or" them together.

hasHumanDep :: (MonadLogger m) => CalculationMap -> String -> m Bool
hasHumanDep calculationMap nodeName = case calculationMap HM.! nodeName of
  HumanVal -> return True
  (FinalValue _) -> return False
  (Operation _ s1 s2) -> do
    human1 <- hasHumanDep calculationMap s1
    human2 <- hasHumanDep calculationMap s2
    return $ human1 || human2

With this function finished, we can start writing another recursive function to get the human value based on an expected outcome. The general outline for this is:

  1. Determine which variable depends on the human value.
  2. Solve the other variable (which does not depend on it).
  3. Recursively determine a new expected value of the human-dependent variable.

This process starts with a couple base cases. Once we reach the HumanVal itself, we can simply return the expected value. If we encounter a FinalValue, something has gone wrong, because we should only call this on human-dependent nodes in our tree.

getHumanValForExpectedOutcome :: (MonadLogger m, MonadFail m) => CalculationMap -> Int64 -> String -> m Int64
getHumanValForExpectedOutcome calculationMap expected nodeName = case calculationMap HM.! nodeName of
  HumanVal -> return expected
  (FinalValue _) -> fail "This node doesn't actually depend on human value! Check implementation of hasHumanDep."
  (Operation op s1 s2) -> ...

For the Operation case, we start by determining which node is human-dependent. There are a couple fail cases here, if both or neither are dependent.

getHumanValForExpectedOutcome calculationMap expected nodeName = case calculationMap HM.! nodeName of
  HumanVal -> return expected
  (FinalValue _) -> fail "This node doesn't actually depend on human value! Check implementation of hasHumanDep."
  (Operation op s1 s2) -> do
    human1 <- hasHumanDep calculationMap s1
    human2 <- hasHumanDep calculationMap s2
    case (human1, human2) of
      (True, True) -> fail "Both sides have human dependency...can't use this approach!"
      (False, False) -> fail "Neither side has human dependency! Check implementation of hasHumanDep."
      ...

But now assuming we have a True/False or False/True, we begin by solving the non-dependent variable.

getHumanValForExpectedOutcome :: (MonadLogger m, MonadFail m) => CalculationMap -> Int64 -> String -> m Int64
getHumanValForExpectedOutcome calculationMap expected nodeName = case calculationMap HM.! nodeName of
  HumanVal -> return expected
  (FinalValue _) -> fail "This node doesn't actually depend on human value! Check implementation of hasHumanDep."
  (Operation op s1 s2) -> do
    human1 <- hasHumanDep calculationMap s1
    human2 <- hasHumanDep calculationMap s2
    case (human1, human2) of
      (True, True) -> fail "Both sides have human dependency...can't use this approach!"
      (False, False) -> fail "Neither side has human dependency! Check implementation of hasHumanDep."
      (True, False) -> do
        v2 <- solveValue calculationMap s2
        ...
      (False, True) -> do
        v1 <- solveValue calculationMap s1
        ...

Depending on the operation, we then determine a new "expected" value for the dependent value, and recurse. We can do this with basic algebra. Suppose our operation is Plus in the first case. The following statement is true:

expected = (s1) + v2

Therefore:

(s1) = v2 - expected

Similarly:

expected = (s1) - v2 ~-> (s1) = expected + v2
expected = (s1) * v2 ~-> (s1) = expected / v2
expected = (s1) / v2 ~-> (s1) = expected * v2

Here's how we fill in the function:

getHumanValForExpectedOutcome :: (MonadLogger m, MonadFail m) => CalculationMap -> Int64 -> String -> m Int64
getHumanValForExpectedOutcome calculationMap expected nodeName = case calculationMap HM.! nodeName of
  HumanVal -> return expected
  (FinalValue _) -> fail "This node doesn't actually depend on human value! Check implementation of hasHumanDep."
  (Operation op s1 s2) -> do
    human1 <- hasHumanDep calculationMap s1
    human2 <- hasHumanDep calculationMap s2
    case (human1, human2) of
      (True, True) -> fail "Both sides have human dependency...can't use this approach!"
      (False, False) -> fail "Neither side has human dependency! Check implementation of hasHumanDep."
      (True, False) -> do
        v2 <- solveValue calculationMap s2
        case op of
          Plus -> getHumanValForExpectedOutcome calculationMap (expected - v2) s1
          Minus -> getHumanValForExpectedOutcome calculationMap (expected + v2) s1
          Times -> getHumanValForExpectedOutcome calculationMap (expected `quot` v2) s1
          Divided -> getHumanValForExpectedOutcome calculationMap (expected * v2) s1
          Equals -> getHumanValForExpectedOutcome calculationMap v2 s1
      (False, True) -> do
        v1 <- solveValue calculationMap s1
        case op of
          Plus -> getHumanValForExpectedOutcome calculationMap (expected - v1) s2
          Minus -> getHumanValForExpectedOutcome calculationMap (v1 - expected) s2
          Times -> getHumanValForExpectedOutcome calculationMap (expected `quot` v1) s2
          Divided -> getHumanValForExpectedOutcome calculationMap (expected * v1) s2
          Equals -> getHumanValForExpectedOutcome calculationMap v1 s2

Of note is the Equals case. Here we expect the two values themselves to be equal, so we completely discard the previous expected value and replace it with either v1 or v2.

Since we've accounted for every case, we can then fill in our caller function quite easily! It updates the map and starts the expected value calculations from root. It does not matter what value we pass to start, because the Equals operation attached to root will discard it.

type HardSolutionType = EasySolutionType

processInputHard :: (MonadFail m, MonadLogger m) => InputType -> m HardSolutionType
processInputHard input = do
  calculationMap <- updateCalculationsHard input
  getHumanValForExpectedOutcome calculationMap 0 "root"

solveHard :: FilePath -> IO (Maybe Int64)
solveHard fp = runStdoutLoggingT $ do
  input <- parseFile parseInput fp
  Just <$> processInputHard input

And now we're done!

Video

Coming eventually.

Previous
Previous

Day 22 - Cube Maze

Next
Next

Day 20 - Shifting Sequences