Tidying
authorNeil Smith <neil.git@njae.me.uk>
Wed, 22 Dec 2021 11:33:47 +0000 (11:33 +0000)
committerNeil Smith <neil.git@njae.me.uk>
Wed, 22 Dec 2021 11:33:47 +0000 (11:33 +0000)
advent19/Main.hs

index e33eaef80204c1c5c38a1caa077c3c2013e85b79..958350b485d0c3708b317b11fd2ac7b087dd69fe 100644 (file)
@@ -1,4 +1,4 @@
--- 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
@@ -8,7 +8,6 @@ import Linear (V3(..), (^+^), (^-^))
 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
@@ -28,7 +27,7 @@ instance Eq Scanner where
 
 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)
@@ -50,8 +49,9 @@ translate v = Endo (v ^+^)
 
 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
 
@@ -62,22 +62,18 @@ 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
@@ -86,11 +82,6 @@ vagueMatch :: Scanner -> Scanner -> Bool
 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
 
@@ -109,24 +100,27 @@ matchingTransformAll scanner1 scanner2 =
 
 
 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