1 -- Writeup at https://work.njae.me.uk/2021/12/19/advent-of-code-2021-day-17/
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
18 data Scanner = Scanner
21 , transformation :: Endo Coord
22 , signature :: MS.MultiSet Int
26 instance Eq Scanner where
27 s1 == s2 = (scannerName s1) == (scannerName s2)
29 data Reconstruction = Reconstruction
30 { found :: [Scanner] -- these have had the transform applied to the beacons
31 , pending :: [Scanner] -- these have had the transform applied to the beacons
32 , waiting :: [Scanner] -- these are as discovered
39 type Transform = Endo Coord
41 instance Show Transform where
42 -- show c = show $ appEndo c (V3 1 2 3)
43 show c = show $ appEndo c (V3 0 0 0)
46 rotX = Endo \(V3 x y z) -> V3 x (- z) y
47 rotY = Endo \(V3 x y z) -> V3 z y (- x)
48 rotZ = Endo \(V3 x y z) -> V3 (- y) x z
49 translate v = Endo (v ^+^)
51 rotations :: [Transform]
52 rotations = [a <> b | a <- ras, b <- rbs]
53 where ras = [nullTrans, rotY, stimes 2 rotY, stimes 3 rotY, rotZ, stimes 3 rotZ]
54 rbs = [nullTrans, rotX, stimes 2 rotX, stimes 3 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
66 -- print $ findCands scanners
67 -- print $ matchingTransform (scanners!!0) (scanners!!1)
68 -- let rc = mkReconstruction scanners
69 -- print $ reconstruct rc
70 print $ part1 transScanners
71 print $ part2 transScanners
73 part1 scanners = S.size $ S.unions $ map (S.fromList . beacons) scanners
75 part2 scanners = maximum [manhattan (a ^-^ b) | a <- origins, b <- origins]
76 where extractOrigin sc = appEndo (transformation sc) (V3 0 0 0)
77 origins = map extractOrigin scanners
78 manhattan (V3 x y z) = (abs x) + (abs y) + (abs z)
81 sign :: [Coord] -> MS.MultiSet Int
82 sign bcns = MS.fromList [pythag (a ^-^ b) | a <- bcns, b <- bcns, a < b]
83 where pythag (V3 x y z) = x^2 + y^2 + z^2
85 vagueMatch :: Scanner -> Scanner -> Bool
86 vagueMatch scanner1 scanner2 = s >= (12 * 11) `div` 2
87 where s = MS.size $ MS.intersection (signature scanner1) (signature scanner2)
90 findCands scs = map onlyNames [(a, b) | a <- scs, b <- scs, a `vagueMatch` b]
91 where onlyNames (sa, sb) = (scannerName sa, scannerName sb)
94 matchingTransform :: Scanner -> Scanner -> Maybe Transform
95 matchingTransform s1 s2 = listToMaybe $ matchingTransformAll s1 s2
97 matchingTransformAll :: Scanner -> Scanner -> [Transform]
98 matchingTransformAll scanner1 scanner2 =
99 do let beacons1 = beacons scanner1
100 let beacons2 = beacons scanner2
104 let t = b1 ^-^ (appEndo rot b2)
105 let translation = translate t
106 let transB2 = map (appEndo (translation <> rot)) beacons2
107 guard $ (length $ intersect beacons1 transB2) >= 12
108 return (translation <> rot)
111 mkReconstruction :: [Scanner] -> Reconstruction
112 mkReconstruction (s:ss) = Reconstruction {found = [], pending = [s], waiting = ss}
115 | null $ waiting r = Reconstruction { found = (found r) ++ (pending r), pending = [], waiting = []}
116 | null $ pending r = r
117 | otherwise = reconstruct $ reconstructStep r
119 reconstructStep Reconstruction{..} =
120 Reconstruction { found = current : found
121 , pending = currents ++ newCurrents
124 where (current:currents) = pending
125 possMatches = filter (vagueMatch current) waiting
126 matches = filter (isJust . snd) $ zip possMatches $ map (matchingTransform current) possMatches
127 waiting' = waiting \\ (map fst matches)
128 newCurrents = map (transformScanner) matches
130 transformScanner (Scanner{..}, trans) =
131 Scanner { beacons = map (appEndo $ fromJust trans) beacons
132 , transformation = fromJust trans
136 -- Parse the input file
138 scannersP = scannerP `sepBy` blankLines
139 scannerP = scannerify <$> nameP <*> beaconsP
141 scannerify name beacons =
142 Scanner { scannerName = name
144 , transformation = nullTrans
145 , signature = sign beacons
148 nameP = ("--- scanner " *>) decimal <* " ---" <* endOfLine
150 beaconsP = beaconP `sepBy` endOfLine
151 beaconP = V3 <$> (signed decimal <* ",") <*> (signed decimal <* ",") <*> (signed decimal)
153 blankLines = many1 endOfLine
155 -- successfulParse :: Text -> (Integer, [Maybe Integer])
156 successfulParse input =
157 case parseOnly scannersP input of
158 Left _err -> [] -- TIO.putStr $ T.pack $ parseErrorPretty err
159 Right scanners -> scanners