⚠️ WIP ⚠️

src/Day17.hs

@@ -125,7 +125,7 @@ addElem roundNumber b@Buffer {..} =
                ++ drop (pos + 1) elems
 
 solution1 :: Int -> Int -> Maybe Int
-solution1 nbOcc nbSteps = finalState & elems & elemAt (1 + (pos finalState))
+solution1 nbOcc nbSteps = finalState & elems & elemAt (1 + pos finalState)
   where
     initState = Buffer [0] 0
     finalState = genState nbOcc nbSteps 0 initState

src/Day20.hs

@@ -63,6 +63,7 @@ import           Control.Lens          hiding ((&))
 -- import           Data.Array
 import           Data.Generics.Product
 -- import qualified Data.Text             as T
+import           Data.List             (partition)
 import qualified Data.Set              as Set
 import           GHC.Generics
 import           Text.Parsec           hiding (State)
@@ -84,6 +85,7 @@ instance Num Coord where
 
 instance Monoid Coord where
   mempty = Coord 0 0 0
+  mappend c1 c2 = c1 + c2
 
 dist :: Coord -> Coord -> Int
 dist c1 c2 = let dv = abs (c1 - c2) in (x dv) + (y dv) + (z dv)
@@ -144,31 +146,52 @@ solution1 input =
 
 type Solution2 = Int
 
+testInput2 :: Text
+testInput2 = "p=<-6,0,0>, v=<3,0,0>, a=<0,0,0>\n\
+             \p=<-4,0,0>, v=<2,0,0>, a=<0,0,0>\n\
+             \p=<-2,0,0>, v=<1,0,0>, a=<0,0,0>\n\
+             \p=<3,0,0>, v=<-1,0,0>, a=<0,0,0>\n"
+
 solution2 :: Input -> Solution2
 solution2 input =
-  let sorted = input
+  input
-               & zip ([0..] :: [Int])
+  & sortParticles
-               & sortOn (\(_,p)->d (pos p))
+  & notCollided
-               & sortOn (\(_,p)->d (vit p))
+  & length
-               & sortOn (\(_,p)->d (acc p))
+
-  in notCollided sorted & map fst & Set.fromList & Set.size
+d :: Coord -> Int
-  where
 d = dist mempty
-    notCollided :: [(Int,Particle)] -> [(Int,Particle)]
+
-    notCollided sorted = do
+sortParticles :: [Particle] -> [Particle]
-      (i,p1) <- sorted
+sortParticles ps =
-      (j,p2) <- sorted
+  ps
-      guard (j > i)
+  & sortOn (d . pos)
-      guard (not (collide p1 p2))
+  & sortOn (d . vit)
-      return (i,p1)
+  & sortOn (d . acc)
+
+notCollided :: [Particle] -> [Particle]
+notCollided (p:ps) =
+  let (deleted,nextList) = partition (collide p) ps in
+  if null deleted
+    then p:notCollided nextList
+    else notCollided nextList
+notCollided ps = ps
+
 collide :: Particle -> Particle -> Bool
-    collide p1 p2 = let trivialracines = [1..10]
+collide p1 p2 = let pr = potentialRacines p1 p2
-                    in checkRacines p1 p2 trivialracines
+                in checkRacines p1 p2 pr
+
 potentialRacines :: Particle -> Particle -> [Int]
-    potentialRacines p1 p2 =
+potentialRacines p1 p2 = mconcat [ potentialRacinesOn (field @"x") p1 p2
-      let a = (acc p1 ^. field @"x") - (acc p2 ^. field @"x")
+                                 , potentialRacinesOn (field @"y") p1 p2
-          b = (vit p1 ^. field @"x") - (vit p2 ^. field @"x")
+                                 , potentialRacinesOn (field @"z") p1 p2
-          c = (pos p1 ^. field @"x") - (pos p2 ^. field @"x")
+                                 ]
+
+potentialRacinesOn :: Lens' Coord Int -> Particle -> Particle -> [Int]
+potentialRacinesOn l p1 p2 =
+  let a = (acc p1 ^. l) - (acc p2 ^. l)
+      b = (vit p1 ^. l) - (vit p2 ^. l)
+      c = (pos p1 ^. l) - (pos p2 ^. l)
   in
     if a /= 0
     then
@@ -176,15 +199,13 @@ solution2 input =
       if delta >= 0
       then [ (-b + isqrt delta) `div` (2*a)
            , (-b - isqrt delta) `div` (2*a)
-               , 1+(-b - isqrt delta) `div` (2*a)
-               , 1+(-b + isqrt delta) `div` (2*a)
-               , 2+(-b - isqrt delta) `div` (2*a)
-               , 2+(-b + isqrt delta) `div` (2*a)
            ] & filter (>0)
       else []
     else [-c `div` b | b /= 0]
+
 isqrt :: Int -> Int
 isqrt = fromIntegral . floor . sqrt . fromIntegral
+
 pol :: Particle -> Particle -> Lens' Coord Int -> (Int -> Int)
 pol p1 p2 l = \x -> a*(x*x) + (b*x) + c
   where
@@ -196,14 +217,17 @@ solution2 input =
     c = (pos p1 ^. l) - (pos p2 ^. l)
 checkRacines :: Particle -> Particle -> [Int] -> Bool
 checkRacines _ _ [] = False
-    checkRacines p1 p2 (x:xs) =
+checkRacines p1 p2 (t:ts) =
-      traceShow (p1,p2,x
+    if (deepseq collided collided)
-                , pol p1 p2 (field @"x") x == 0
+    then -- traceShow ( t
-                , pol p1 p2 (field @"y") x == 0
+         --           , collided
-                , pol p1 p2 (field @"z") x == 0)
+         --           , p1
-                (pol p1 p2 (field @"x") x == 0
+         --           , p2
-                 && pol p1 p2 (field @"y") x == 0
+         --           , pol p1 (Particle 0 0 0) (field @"x") t
-                 && pol p1 p2 (field @"z") x == 0)
+         --           , pol p2 (Particle 0 0 0) (field @"x") t
-      || checkRacines p1 p2 xs
+         --           ) $
-
+         collided
-
+     else checkRacines p1 p2 ts
+  where collided = pol p1 p2 (field @"x") t == 0
+                   && pol p1 p2 (field @"y") t == 0
+                   && pol p1 p2 (field @"z") t == 0