advent of code, haskell

Advent of Code 2021 day 19

Did you know that rotations and translations are endomorphisms in 3-space, and form a monoid under composition? It really helped me solve day 19.

Transformations

Let's unpack that statement a bit. The problem is all about transforming points (beacons) in a three dimensional space, with those transformations being rotations and translations. I define a transformation as being a function that takes a point to another point in 3-space. Because both the input and output of the functions are points in 3-space, the transformation is an endofunction and an endomorphism (its domain and co-domain are the same).

Similarly, I can apply a transformation and then apply another transformation, and there's a null transformation. Composition and a unit item makes transformations a monoid. Unfortunately, it needs to be wrapped in a newtype, so I have to use appEndo to apply a transformation to a point. 

type Coord = V3 Int

type Transform = Endo Coord

instance Show Transform where
  show c = show $ appEndo c (V3 0 0 0)

nullTrans = Endo id
rotX = Endo \(V3 x y z) -> V3    x (- z)   y
rotY = Endo \(V3 x y z) -> V3    z    y (- x)
rotZ = Endo \(V3 x y z) -> V3 (- y)   x    z
translate v = Endo (v ^+^)

rotations :: [Transform]
rotations = [a <> b | a <- ras, b <- rbs]
  where ras = [ nullTrans, rotY, rotY <> rotY, rotY <> rotY <> rotY
              , rotZ, rotZ <> rotZ <> rotZ]
        rbs = [nullTrans, rotX, rotX <> rotX, rotX <> rotX <> rotX]

Scanners

Using beacons and transforms, a Scanner holds information from the data file. I use a list of beacons rather than a set, as I'm using that list as a monad later on.

data Scanner = Scanner 
  { scannerName :: Int
  , beacons :: [Coord]
  , transformation :: Endo Coord
  , signature :: MS.MultiSet Int
  }
  deriving (Show)

instance Eq Scanner where
  s1 == s2 = (scannerName s1) == (scannerName s2)

Each scanner also holds the transform that's been applied to it, and a signature for ruling out scanners that can't match. The signature is something I picked up from many others' solutions. For each scanner, find the distances between all pairs of beacons. Those distances are invariant under rotation and translation. If there are 12 beacons that match between scanners, the distances between those 12 beacons will be common. The signature is the (multi-)set of distances of all points. If two scanners share \( \frac{12 \times (12 - 1)}{2} \) common distances, there's a chance they may match. If they share fewer common distances in the signatures, they can't match.

Parsing the scanners involves a bit of processing at the same time, such as calculating the signatures.

scannersP = scannerP `sepBy` blankLines
scannerP = scannerify <$> nameP <*> beaconsP
  where 
    scannerify name beacons = 
      Scanner { scannerName = name
              , beacons = beacons
              , transformation = nullTrans
              , signature = sign beacons
              }

nameP = ("--- scanner " *>) decimal <* " ---" <* endOfLine

beaconsP = beaconP `sepBy` endOfLine
beaconP = V3 <$> (signed decimal <* ",") <*> (signed decimal <* ",") <*> (signed decimal)

blankLines = many1 endOfLine

sign :: [Coord] -> MS.MultiSet Int
sign bcns = MS.fromList [pythag (a ^-^ b) | a <- bcns, b <- bcns, a < b]
  where pythag (V3 x y z) = x^2 + y^2 + z^2

vagueMatch :: Scanner -> Scanner -> Bool
vagueMatch scanner1 scanner2 = s >= (12 * 11) `div` 2
  where s = MS.size $ MS.intersection (signature scanner1) (signature scanner2)

vagueMatch is shown here, as we're talking signatures at the moment.

Matching scanners

The final part of the solution is matching two scanners and finding the transform that does so.

The basic idea is is:

  1. Pick a beacon in scanner 1
  2. Pick a beacon in scanner 2
  3. Pick a rotation
  4. Rotate the beacon from scanner 2, then find the translation needed to slide that beacon onto the beacon from scanner 1
  5. Apply the rotation and translation to every beacon in scanner 2
  6. If at least 12 beacons now have the same positions in both scanners, return the transformation.

All this repeated "pick an item from a list" suggests using lists as monads to represent the non-deterministic nature of the process (the beacons and rotations are chosen arbitrarily).

The process will return the same transformation multiple times (if it exists), once for each pair of beacons that end up matching. listToMaybe tidies things up for me.

matchingTransform :: Scanner -> Scanner -> Maybe Transform
matchingTransform s1 s2 = listToMaybe $ matchingTransformAll s1 s2

matchingTransformAll :: Scanner -> Scanner -> [Transform]
matchingTransformAll scanner1 scanner2 = 
  do  let beacons1 = beacons scanner1
      let beacons2 = beacons scanner2
      rot <- rotations
      b1 <- beacons1
      b2 <- beacons2
      let t = b1 ^-^ (appEndo rot b2)
      let translation = translate t
      let transB2 = map (appEndo (translation <> rot)) beacons2
      guard $ (length $ intersect beacons1 transB2) >= 12
      return (translation <> rot)

Reconstruction

Now all the pieces are in place, it's time to reconstruct the scanner set. A Reconstruction holds the process in motion. The scanners in waiting are those that haven't been processed. The scanners in working has been transformed into the scanner-0 frame of reference, and I'm about to see what waiting scanners will match them. Once I've found all the scanners that overlap with a working scanner, the working scanner is put in found.

data Reconstruction = Reconstruction 
  { found :: [Scanner] -- these have had the transform applied to the beacons
  , working :: [Scanner] -- these have had the transform applied to the beacons
  , waiting :: [Scanner] -- these are as discovered
  }
  deriving (Show)

reconstruct does the whole reconstruction. When working is empty, the reconstruction is finished. Otherwise, reconstructStep handles the first working scanner.

reconstructStep finds matching scanners in two steps (first using the signatures, then by finding the transform). The matching scanners are transformed into the scanner-0 frame then added to working.

mkReconstruction :: [Scanner] -> Reconstruction
mkReconstruction (s:ss) = Reconstruction {found = [], working = [s], waiting = ss}

reconstruct :: Reconstruction -> Reconstruction
reconstruct r 
  | working r == [] = r
  | otherwise = reconstruct $ reconstructStep r

reconstructStep :: Reconstruction -> Reconstruction
reconstructStep Reconstruction{..} = 
  Reconstruction { found = current : found
                 , working = workers ++ newWorkers
                 , waiting = waiting'
                 }
  where (current:workers) = working
        possMatches = filter (vagueMatch current) waiting
        matches = filter (isJust . snd) $ zip possMatches $ map (matchingTransform current) possMatches
        waiting' = waiting \\ (map fst matches)
        newWorkers = map (transformScanner) matches

transformScanner :: (Scanner, Maybe Transform) -> Scanner
transformScanner (Scanner{..}, trans) = 
  Scanner { beacons = map (appEndo $ fromJust trans) beacons
          , transformation = fromJust trans
          , ..}

Solving the puzzles

The final steps are simple, given the reconstructed scanners. Part 1 is just the union of all the sets of beacons. Part 2 uses the stored transform to find the position of each scanner (transform the origin in the scanner's frame to the scanner-0 frame), then finds the greatest distance between all pairs.

part1 :: [Scanner] -> Int
part1 scanners = S.size $ S.unions $ map (S.fromList . beacons) scanners

part2 :: [Scanner] -> Int
part2 scanners = maximum [manhattan (a ^-^ b) | a <- origins, b <- origins]
  where extractOrigin sc = appEndo (transformation sc) (V3 0 0 0)
        origins = map extractOrigin scanners
        manhattan (V3 x y z) = (abs x) + (abs y) + (abs z)

Code

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