1 -- Writeup at https://work.njae.me.uk/2021/12/21/advent-of-code-2021-day-19/
4 import qualified Data.Text.IO as TIO
5 import Data.Attoparsec.Text hiding (take, takeWhile)
7 import Linear (V3(..), (^+^), (^-^))
8 import qualified Data.Set as S
9 import qualified Data.MultiSet as MS
17 data Scanner = Scanner
20 , transformation :: Endo Coord
21 , signature :: MS.MultiSet Int
25 instance Eq Scanner where
26 s1 == s2 = (scannerName s1) == (scannerName s2)
28 data Reconstruction = Reconstruction
29 { found :: [Scanner] -- these have had the transform applied to the beacons
30 , working :: [Scanner] -- these have had the transform applied to the beacons
31 , waiting :: [Scanner] -- these are as discovered
38 type Transform = Endo Coord
40 instance Show Transform where
41 -- show c = show $ appEndo c (V3 1 2 3)
42 show c = show $ appEndo c (V3 0 0 0)
45 rotX = Endo \(V3 x y z) -> V3 x (- z) y
46 rotY = Endo \(V3 x y z) -> V3 z y (- x)
47 rotZ = Endo \(V3 x y z) -> V3 (- y) x z
48 translate v = Endo (v ^+^)
50 rotations :: [Transform]
51 rotations = [a <> b | a <- ras, b <- rbs]
52 where ras = [ nullTrans, rotY, rotY <> rotY, rotY <> rotY <> rotY
53 , rotZ, rotZ <> rotZ <> rotZ]
54 rbs = [nullTrans, rotX, rotX <> rotX, rotX <> rotX <> rotX]
60 do text <- TIO.readFile "data/advent19.txt"
61 let scanners = successfulParse text
62 let rec0 = mkReconstruction scanners
63 let rec = reconstruct rec0
64 let transScanners = found rec
65 print $ part1 transScanners
66 print $ part2 transScanners
68 part1 :: [Scanner] -> Int
69 part1 scanners = S.size $ S.unions $ map (S.fromList . beacons) scanners
71 part2 :: [Scanner] -> Int
72 part2 scanners = maximum [manhattan (a ^-^ b) | a <- origins, b <- origins]
73 where extractOrigin sc = appEndo (transformation sc) (V3 0 0 0)
74 origins = map extractOrigin scanners
75 manhattan (V3 x y z) = (abs x) + (abs y) + (abs z)
77 sign :: [Coord] -> MS.MultiSet Int
78 sign bcns = MS.fromList [pythag (a ^-^ b) | a <- bcns, b <- bcns, a < b]
79 where pythag (V3 x y z) = x^2 + y^2 + z^2
81 vagueMatch :: Scanner -> Scanner -> Bool
82 vagueMatch scanner1 scanner2 = s >= (12 * 11) `div` 2
83 where s = MS.size $ MS.intersection (signature scanner1) (signature scanner2)
85 matchingTransform :: Scanner -> Scanner -> Maybe Transform
86 matchingTransform s1 s2 = listToMaybe $ matchingTransformAll s1 s2
88 matchingTransformAll :: Scanner -> Scanner -> [Transform]
89 matchingTransformAll scanner1 scanner2 =
90 do let beacons1 = beacons scanner1
91 let beacons2 = beacons scanner2
95 let t = b1 ^-^ (appEndo rot b2)
96 let translation = translate t
97 let transB2 = map (appEndo (translation <> rot)) beacons2
98 guard $ (length $ intersect beacons1 transB2) >= 12
99 return (translation <> rot)
102 mkReconstruction :: [Scanner] -> Reconstruction
103 mkReconstruction (s:ss) = Reconstruction {found = [], working = [s], waiting = ss}
105 reconstruct :: Reconstruction -> Reconstruction
107 -- | waiting r == [] = Reconstruction { found = (found r) ++ (working r), working = [], waiting = []}
108 | working r == [] = r
109 | otherwise = reconstruct $ reconstructStep r
111 reconstructStep :: Reconstruction -> Reconstruction
112 reconstructStep Reconstruction{..} =
113 Reconstruction { found = current : found
114 , working = workers ++ newWorkers
117 where (current:workers) = working
118 possMatches = filter (vagueMatch current) waiting
119 matches = filter (isJust . snd) $ zip possMatches $ map (matchingTransform current) possMatches
120 waiting' = waiting \\ (map fst matches)
121 newWorkers = map (transformScanner) matches
123 transformScanner :: (Scanner, Maybe Transform) -> Scanner
124 transformScanner (Scanner{..}, trans) =
125 Scanner { beacons = map (appEndo $ fromJust trans) beacons
126 , transformation = fromJust trans
130 -- Parse the input file
132 scannersP = scannerP `sepBy` blankLines
133 scannerP = scannerify <$> nameP <*> beaconsP
135 scannerify name beacons =
136 Scanner { scannerName = name
138 , transformation = nullTrans
139 , signature = sign beacons
142 nameP = ("--- scanner " *>) decimal <* " ---" <* endOfLine
144 beaconsP = beaconP `sepBy` endOfLine
145 beaconP = V3 <$> (signed decimal <* ",") <*> (signed decimal <* ",") <*> (signed decimal)
147 blankLines = many1 endOfLine
149 -- successfulParse :: Text -> (Integer, [Maybe Integer])
150 successfulParse input =
151 case parseOnly scannersP input of
152 Left _err -> [] -- TIO.putStr $ T.pack $ parseErrorPretty err
153 Right scanners -> scanners