/wakamoleguy

Advent of Code 2022 - Day 13: Distress Signal

It's been several months since I paused on Advent of Code 2022, and I am now attempting to return. Today's challenge, Day 13: Distress Signal, is one that I actually solved back in December but never wrote up. Let's hope I can decipher the code!

A Custom Ordering

The challenge today is largely to define a custom ordering for a recursive Packet data type. Our Packet data type captures the shape:

data Packet = Leaf Int | ListOf [Packet] deriving (Show, Eq)

parsePacket :: GenParser Char u Packet
parsePacket = try parseLeaf <|> parseList
  where
    parseLeaf = Leaf <$> parseInt
    parseList = between (char '[') (char ']') $ do
      packets <- sepBy parsePacket (char ',')
      return $ ListOf packets

To define the ordering of Packets, we instanciate an Ord class for the type. The minimal definition is a compare function which can take 2 Packets and return LT, EQ, or GT. The code follows the problem description closely:

instance Ord Packet where
  compare :: Packet -> Packet -> Ordering
  compare (Leaf a) (Leaf b) = compare a b
  compare (Leaf a) bs = compare (ListOf [Leaf a]) bs
  compare as (Leaf b) = compare as (ListOf [Leaf b])
  compare (ListOf []) (ListOf []) = EQ
  compare (ListOf []) (ListOf _) = LT
  compare (ListOf _) (ListOf []) = GT
  compare (ListOf (a : as)) (ListOf (b : bs)) = case compare a b of
    EQ -> compare (ListOf as) (ListOf bs)
    x -> x

Instance Signature?

Now, the code for our Ord instance is actually not valid Haskell! Instance declarations are not allowed to have type signatures in them. That's the line with compare :: Package -> Packet -> Ordering. The instance should be able to infer all of this information.

However, sometimes providing the type signature is useful, especially for novices like me! It's possible to enable this via the {-# LANGUAGE InstanceSigs #-} language extension.

By putting such a language extension pragma at the top of the file, we ask the compiler to enable additional language features. In this case it's a simple and safe rule, but extensions can get pretty complex!

Part 1 - Parsing the List of Pairs

In Part 1, we want to process each pair of Packets together, and then count whether they are in the correct order. To parse them together, I wrote a helper classlistToPair:

listToPair :: Show a => [a] -> (a, a)
listToPair [a, b] = (a, b)
listToPair l = error $ "listToPair: invalid input: " ++ show l

We first split the list into sub-lists containing two elements, then convert those sublists into tuples. Since the parsing returns an Either, we provide a default Leaf 0 fallback, although this should not be hit with our real input data.

input :: IO [(Packet, Packet)]
input =
  let rawPairs = splitOn [""] . lines <$> readDay 2022 13
   in fmap (listToPair . fmap (fromRight (Leaf 0) . parse parsePacket "")) <$> rawPairs

Now that we have our list of pairs, we can find our answer to Part 1. If we were going to count the correctly ordered pairs, we could apply our compare function, filter out any incorrectly ordered pairs, and then take the length of the remaining list:

countOrdered :: [(Packet, Packet)] -> Int
countOrdered =
  length
    . filter (== LT)
    . fmap (uncurry compare)

However, we need the index of the resulting pairs, so let's attach that to our items first. Then at the end, instead of counting, we will sum the index:

part1 :: [(Packet, Packet)] -> Int
part1 =
  sum
    . fmap fst
    . filter (\(_, o) -> o == LT)
    . fmap (fmap (uncurry compare))
    . zip [1 ..]

Part 2

For Part 2, we are asked to sort the full list of Packets, ignoring the pairings. Additionally, we will sort our two divider packets, [[2]] and [[6]]. With our Ord instance, sorting is as simple as passing the list of Packets to sort!

Rather than parse our input again, I opted to start with the list of pairs, flattening it back into a single list:

part2 :: [(Packet, Packet)] -> Int
part2 pairs = undefined -- TODO
  where
    dividers = [ListOf [ListOf [Leaf 2]], ListOf [ListOf [Leaf 6]]]
    sortedPackets = sort $ dividers ++ concatMap (\(a, b) -> [a, b]) pairs

Once we have our sorted list, we look for the indexes of our two dividers and multiply them together to get our final answer:

part2 :: [(Packet, Packet)] -> Int
part2 pairs = product $ (+ 1) <$> mapMaybe (`elemIndex` sortedPackets) dividers
  where
    dividers = [ListOf [ListOf [Leaf 2]], ListOf [ListOf [Leaf 6]]]
    sortedPackets = sort $ dividers ++ concatMap (\(a, b) -> [a, b]) pairs

Do you need to fully sort?

Instead of sorting the full list, we could take a more target approach to finding the indexes of our dividers. The index of an element is only dependent on how many Packets sort lower than it, not the internal ordering of those packets.

Sorting the list is O(n log n). Sometimes Haskell's laziness will allow us to skip some sorting in these cases. However, it must fully sort each item up until our dividers, so our Big O time is unchanged.

Counting how many Packets are less than a given divider is O(n), as it can be done in a single pass through the list. We have 2 dividers, adding a constant factor.

I didn't end up implementing this approach, but it should have faster runtime characteristics on large lists (which frankly, is not our input).

Full Code

{-# LANGUAGE InstanceSigs #-}

module AOC2022.Day13 (spec) where

import Data.Either
import Data.List (elemIndex, sort)
import Data.List.Split (splitOn)
import Data.Maybe (mapMaybe)
import Input
import Test.Hspec
import Text.ParserCombinators.Parsec

listToPair :: Show a => [a] -> (a, a)
listToPair [a, b] = (a, b)
listToPair l = error $ "listToPair: invalid input: " ++ show l

input :: IO [(Packet, Packet)]
input =
  let rawPairs = splitOn [""] . lines <$> readDay 2022 13
   in fmap (listToPair . fmap (fromRight (Leaf 0) . parse parsePacket "")) <$> rawPairs

data Packet = Leaf Int | ListOf [Packet] deriving (Show, Eq)

parsePacket :: GenParser Char u Packet
parsePacket = try parseLeaf <|> parseList
  where
    parseLeaf = Leaf <$> parseInt
    parseList = between (char '[') (char ']') $ do
      packets <- sepBy parsePacket (char ',')
      return $ ListOf packets

instance Ord Packet where
  compare :: Packet -> Packet -> Ordering
  compare (Leaf a) (Leaf b) = compare a b
  compare (Leaf a) bs = compare (ListOf [Leaf a]) bs
  compare as (Leaf b) = compare as (ListOf [Leaf b])
  compare (ListOf []) (ListOf []) = EQ
  compare (ListOf []) (ListOf _) = LT
  compare (ListOf _) (ListOf []) = GT
  compare (ListOf (a : as)) (ListOf (b : bs)) = case compare a b of
    EQ -> compare (ListOf as) (ListOf bs)
    x -> x

spec :: IO ()
spec = hspec $ do
  describe "Day 13" $ do
    describe "Part 1" $ do
      it "runs on custom input" $ do
        myInput <- input
        part1 myInput `shouldBe` 0 -- redacted
    describe "Part 2" $ do
      it "runs on custom input" $ do
        myInput <- input
        part2 myInput `shouldBe` 0 -- redacted

part1 :: [(Packet, Packet)] -> Int
part1 =
  sum
    . fmap fst
    . filter (\(_, o) -> o == LT)
    . fmap (fmap (uncurry compare))
    . zip [1 ..]

part2 :: [(Packet, Packet)] -> Int
part2 pairs = product $ (+ 1) <$> mapMaybe (`elemIndex` sortedPackets) dividers
  where
    dividers = [ListOf [ListOf [Leaf 2]], ListOf [ListOf [Leaf 6]]]
    sortedPackets = sort $ dividers ++ concatMap (\(a, b) -> [a, b]) pairs

Advent of Code 2022 Series

This post is part of a series describing my Haskell solutions to Advent of Code 2022.

Previous: Day 12: Hill Climbing Algorithm

Cheers!