--- Writeup at https://work.njae.me.uk/2021/12/19/advent-of-code-2021-day-17/
+-- Writeup at https://work.njae.me.uk/2021/12/21/advent-of-code-2021-day-19/
import Data.Text ()
import qualified Data.Text.IO as TIO
import qualified Data.Set as S
import qualified Data.MultiSet as MS
import Data.Monoid
-import Data.Semigroup
import Data.Maybe
import Data.List
import Control.Monad
data Reconstruction = Reconstruction
{ found :: [Scanner] -- these have had the transform applied to the beacons
- , pending :: [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)
rotations :: [Transform]
rotations = [a <> b | a <- ras, b <- rbs]
- where ras = [nullTrans, rotY, stimes 2 rotY, stimes 3 rotY, rotZ, stimes 3 rotZ]
- rbs = [nullTrans, rotX, stimes 2 rotX, stimes 3 rotX]
+ where ras = [ nullTrans, rotY, rotY <> rotY, rotY <> rotY <> rotY
+ , rotZ, rotZ <> rotZ <> rotZ]
+ rbs = [nullTrans, rotX, rotX <> rotX, rotX <> rotX <> rotX]
-- Main
let rec0 = mkReconstruction scanners
let rec = reconstruct rec0
let transScanners = found rec
- -- print scanners
- -- print $ findCands scanners
- -- print $ matchingTransform (scanners!!0) (scanners!!1)
- -- let rc = mkReconstruction scanners
- -- print $ reconstruct rc
print $ part1 transScanners
print $ part2 transScanners
+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)
-
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 scanner1 scanner2 = s >= (12 * 11) `div` 2
where s = MS.size $ MS.intersection (signature scanner1) (signature scanner2)
-
-findCands scs = map onlyNames [(a, b) | a <- scs, b <- scs, a `vagueMatch` b]
- where onlyNames (sa, sb) = (scannerName sa, scannerName sb)
-
-
matchingTransform :: Scanner -> Scanner -> Maybe Transform
matchingTransform s1 s2 = listToMaybe $ matchingTransformAll s1 s2
mkReconstruction :: [Scanner] -> Reconstruction
-mkReconstruction (s:ss) = Reconstruction {found = [], pending = [s], waiting = ss}
+mkReconstruction (s:ss) = Reconstruction {found = [], working = [s], waiting = ss}
+reconstruct :: Reconstruction -> Reconstruction
reconstruct r
- | null $ waiting r = Reconstruction { found = (found r) ++ (pending r), pending = [], waiting = []}
- | null $ pending r = r
+ -- | waiting r == [] = Reconstruction { found = (found r) ++ (working r), working = [], waiting = []}
+ | working r == [] = r
| otherwise = reconstruct $ reconstructStep r
+reconstructStep :: Reconstruction -> Reconstruction
reconstructStep Reconstruction{..} =
Reconstruction { found = current : found
- , pending = currents ++ newCurrents
+ , working = workers ++ newWorkers
, waiting = waiting'
}
- where (current:currents) = pending
+ where (current:workers) = working
possMatches = filter (vagueMatch current) waiting
matches = filter (isJust . snd) $ zip possMatches $ map (matchingTransform current) possMatches
waiting' = waiting \\ (map fst matches)
- newCurrents = map (transformScanner) matches
+ newWorkers = map (transformScanner) matches
+transformScanner :: (Scanner, Maybe Transform) -> Scanner
transformScanner (Scanner{..}, trans) =
Scanner { beacons = map (appEndo $ fromJust trans) beacons
, transformation = fromJust trans