Day 25 - Balanced Quinary

This is it - the last problem! I'll be taking a bit of a break after this, but the blog will be back in January! At some point I'll have some more detailed walkthroughs for Days 16 & 17, and I'll get to video walkthroughs for the second half of problems as well.

Solution code on GitHub

All 2022 Problems

Subscribe to Monday Morning Haskell!

Problem Overview

Full Description

Today's problem only has 1 part. To get the second star for the problem, you need to have gotten all the other stars from prior problems. For the problem, we'll be decoding and encoding balanced quinary numbers. Normal quinary would be like binary except using the digits 0-4 instead of just 0 and 1. But in balanced quinary, we have the digits 0-2 and then we have the - character representing -1 and the = character representing -2. So the number 1= means "1 times 5 to the first power plus (-2) times 5 to the zero power". So the numeral 1= gives us the value 3 (5 - 2).

We'll take a series of numbers written in quinary, convert them to decimal, take their sum, and then convert the result back to quinary.

Parsing the Input

Here's a sample input:

1=-0-2
12111
2=0=
21
2=01
111
20012
112
1=-1=
1-12
12
1=
122

Each line has a series of 5 possible characters, so parsing this is pretty easy. We'll convert the characters directly into integers for convenience.

parseInput :: (MonadLogger m) => ParsecT Void Text m InputType
parseInput = sepEndBy1 parseLine eol

type InputType = [LineType]
type LineType = [Int]

parseLine :: (MonadLogger m) => ParsecT Void Text m LineType
parseLine = some parseSnafuNums

parseSnafuNums :: (MonadLogger m) => ParsecT Void Text m Int
parseSnafuNums =
  (char '2' >> return 2) <|>
  (char '1' >> return 1) <|>
  (char '0' >> return 0) <|>
  (char '-' >> return (-1)) <|>
  (char '=' >> return (-2))

Decoding Numbers

Decoding is a simple process.

  1. Reverse the string and zip the numbers with their indices (starting from 0)
  2. Add them together with a fold. Each step will raise 5 to the index power and add it to the previous value.
translateSnafuNum :: [Int] -> Integer
translateSnafuNum nums = foldl addSnafu 0 (zip [0,1..] (reverse nums))
  where
    addSnafu prev (index, num) = fromIntegral (5 ^ index * num) + prev

This lets us "process" the input and return an Integer representing the sum of our inputs.

type EasySolutionType = Integer

processInputEasy :: (MonadLogger m) => InputType -> m EasySolutionType
processInputEasy inputs = do
  let decimalNums = map translateSnafuNum inputs
  return (sum decimalNums)

Encoding

Now we have to re-encode this sum. We'll do this by way of a tail recursive helper function. Well, almost tail recursive. One case technically isn't. But the function takes a few arguments.

  1. The "remainder" of the number we are trying to encode
  2. The current "power of 5" that is the next one greater than our remainder number
  3. The accumulated digits we've placed so far.

So here's our type signature (though I flipped the first two arguments for whatever reason):

decimalToSnafuTail :: (MonadLogger m) => Integer -> Integer -> [Int] -> m [Int]
decimalToSnafuTail power5 remainder accum = ...

It took me a while to work out exactly what the cases are here. They're not completely intuitive. But here's my list.

  1. Base case: absolute value of remainder is less than 3
  2. Remainder is greater than half of the current power of 5.
  3. Remainder is at least 2/5 of the power of 5.
  4. Remainder is at least 1/5 of the power of 5.
  5. Remainder is smaller than 1/5 of the power of 5.

Most of these cases appear to be easy. In the base case we add the digit itself onto our list and then reverse it. In cases 3-5, we place the digit 2,1 and 0, respectively, and then recurse on the remainder after subtracting the appropriate amount (based on the "next" smaller power of 5).

decimalToSnafuTail :: (MonadLogger m) => Integer -> Integer -> [Int] -> m [Int]
decimalToSnafuTail power5 remainder accum
  | abs remainder < 3 = return $ reverse (fromIntegral remainder : accum)
  | remainder > (power5 `quot` 2) = ...
  | remainder >= 2 * next5 = decimalToSnafuTail next5 (remainder - (2 * next5)) (2 : accum)
  | remainder >= power5 `quot` 5 = decimalToSnafuTail next5 (remainder - next5) (1 : accum)
  | otherwise = decimalToSnafuTail next5 remainder (0 : accum)
  where
    next5 = power5 `quot` 5

This leaves the case where our value is greater than half of the current power5. This case is the one that introduces negative values into the equation. And in fact, it means we actually have to "carry a one" back into the last accumulated value of the list. We'll have another "1" for the current power of 5, and then the remainder will start with a negative value.

What I realized for this case is that we can do the following:

  1. Carry the 1 back into our previous accumulation
  2. Subtract the current remainder from the current power of 5.
  3. Derive the quinary representation of this value, and then invert it.

Fortunately, the "carry the 1" step can't cascade. If we've placed a 2 from case 3, the following step can't run into case 2. We can think of it this way. Case 3 means our remainder is 40-50% of the current 5 power. Once we subtract the 40%, the remaining 10% cannot be more than half of 20% of the current 5 power. It seems

Now case 2 actually isn't actually tail recursive! We'll make a separate recursive call with the smaller Integer values, but we'll pass an empty accumulator list. Then we'll flip the resulting integers, and add it back into our number. The extra post-processing of the recursive result is what makes it "not tail recursive".

decimalToSnafuTail :: (MonadLogger m) => Integer -> Integer -> [Int] -> m [Int]
decimalToSnafuTail power5 remainder accum
  | abs remainder < 3 = return $ reverse (fromIntegral remainder : accum)
  {- Case 2 -}
  | remainder > (power5 `quot` 2) = do
    let add1 = if null accum then [1] else head accum + 1 : tail accum
    recursionResult <- decimalToSnafuTail power5 (power5 - remainder) []
    return $ reverse add1 ++ map ((-1) *) recursionResult
  {- End Case 2 -}
  | remainder >= 2 * next5 = decimalToSnafuTail next5 (remainder - (2 * next5)) (2 : accum)
  | remainder >= power5 `quot` 5 = decimalToSnafuTail next5 (remainder - next5) (1 : accum)
  | otherwise = decimalToSnafuTail next5 remainder (0 : accum)
  where
    next5 = power5 `quot` 5

Once we have this encoding function, tying everything together is easy! We just source the first greater power of 5, and translate each number in the resulting list to a character.

findEasySolution :: (MonadLogger m) => EasySolutionType -> m String
findEasySolution number = do
  finalSnafuInts <- decimalToSnafuTail first5Power number []
  return (intToSnafuChar <$> finalSnafuInts)
  where
    first5Power = head [n | n <- map (5^) [0,1..], n >= number]

intToSnafuChar :: Int -> Char
intToSnafuChar 2 = '2'
intToSnafuChar 1 = '1'
intToSnafuChar (-1) = '-'
intToSnafuChar (-2) = '='
intToSnafuChar _ = '0'

And our last bit of code to tie these parts together:

solveEasy :: FilePath -> IO String
solveEasy fp = runStdoutLoggingT $ do
  input <- parseFile parseInput fp
  result <- processInputEasy input
  findEasySolution result

And that's the solution! All done for this year!

Video

Coming eventually.

Previous
Previous

Monads According to a Robot

Next
Next

Day 24 - Graph Problem Redemption