Day 22 - fixed part 2 (Visiteds should save Key, not just Coordinate); Day 23 - part 2 using SBV (but runs very slowly).

README.md

@@ -25,7 +25,7 @@ Now located in this repository's wiki.
 | 11  | ~ 7         |
 | 12  | ~ 1.5       |
 | 13  | ~ 0.5       |
-| 14  |  22.3       |
+| 14  |   22        |
 | 15  |             |
 | 16  | ~ 1         |
 | 17  | ~ 15        |
@@ -33,7 +33,7 @@ Now located in this repository's wiki.
 | 19  | ~ 3         |
 | 20  | ~ 40        |
 | 21  | ~ 1         |
-| 22  |             |
-| 23  |             |
+| 22  |   23        |
+| 23  |   128       |
 | 24  |             |
 | 25  |             |

app/Main.hs

@@ -30,4 +30,4 @@ import qualified Day24
 import qualified Day25
 
 main :: IO ()
-main = Day23.main
+main = Day24.main

package.yaml

@@ -28,6 +28,7 @@ dependencies:
 - vector
 - array
 - parsec
+- sbv
 
 library:
   source-dirs: src

src/Day22.hs

@@ -5,11 +5,10 @@ import Data.Map.Strict (Map, (!), insert, member, empty)
 import Data.Set (Set, notMember)
 import qualified Data.Set as S (insert, fromList)
 import Data.Ix (range)
-import PSQueue (Binding(..), PSQ, minView, insertBindingWith, fromList)
-import Debug.Trace (traceShow)
+import PSQueue (Binding(..), PSQ, minView, insertWith, fromList, size)
 
 type ErosionLevels = Map Coordinate Int
-type Visiteds = Set Coordinate
+type Visiteds = Set Key
 type Coordinate = (Int, Int) -- (x, y)
 type Queue = PSQ Key Int
 type Key = (Coordinate, Tool)
@@ -63,18 +62,19 @@ getBinding els ((sCoord, sTool) :-> sTime) tCoord =
 
 getTargetTime :: Visiteds -> (Queue, ErosionLevels) -> Int
 getTargetTime vis (q, els) =
-    let Just (region@((coord, _) :-> time), q') = minView q
+    let Just (region@(key@(coord, _) :-> time), q') = minView q
         neighbours = getNeighbours coord
     in  if   coord == target then time
-        else getTargetTime (S.insert coord vis) $ foldl' (insertCoord region) (q', els) neighbours
+        else getTargetTime (S.insert key vis) $ foldl' (insertCoord region) (q', els) neighbours
     where
         -- source binding -> (queue, erosion levels) -> target coordinate -> (queue with target binding, updated erosion levels)
         insertCoord :: Binding Key Int -> (Queue, ErosionLevels) -> Coordinate -> (Queue, ErosionLevels)
         insertCoord region (q, els) coord =
-            let (binding, els') = getBinding els region coord
-            in  (insertBindingWith min binding q, els')
+            let (key :-> time, els') = getBinding els region coord
+                q' = if notMember key vis then insertWith min key time q else q
+            in  (q', els')
         getNeighbours :: (Int, Int) -> [(Int, Int)]
-        getNeighbours coord@(x, y) = filter (\coord@(x, y) -> x >= 0 && y >= 0 && notMember coord vis)
+        getNeighbours coord@(x, y) = filter (\coord@(x, y) -> x >= 0 && y >= 0)
             [(x - 1, y), (x, y - 1), (x + 1, y), (x, y + 1)]
 
 part1 :: Int
@@ -82,8 +82,8 @@ part1 = sum . fmap (`mod` 3) . snd . foldl' getErosionLevel (0, empty) $ range (
 
 part2 :: Int
 part2 =
-    let q = fromList $ [((0, 0), Torch) :-> 0]
-        vis = S.fromList [(0, 0)]
+    let q   = fromList $ [((0, 0), Torch) :-> 0]
+        vis = S.fromList [((0, 0), Torch)]
     in  getTargetTime vis (q, empty)
 
 main :: IO ()

src/Day23.hs

@@ -1,35 +1,60 @@
 module Day23 (main) where
 
-data Bot = Bot Position Radius deriving (Eq)
-type Position = (Int, Int, Int)
-type Radius = Int
+import Data.SBV
+
+manhattan :: Num a => (a, a, a) -> (a, a, a) -> a
+manhattan (x1, y1, z1) (x2, y2, z2) = abs (x1 - x2) + abs (y1 - y2) + abs (z1 - z2)
+
+
+-- Part 1 --
+
+data Bot = Bot Position Radius deriving Eq
+type Position = (Integer, Integer, Integer)
+type Radius = Integer
 
 instance Ord Bot where
     Bot _ rad1 <= Bot _ rad2 = rad1 <= rad2
 
 parse :: String -> Bot
 parse str =
-    let pos = takeWhile (/= '>') . drop 5 $ str
-        rad = drop 2 . last . words $ str
-    in  Bot (read $ "(" ++ pos ++ ")") (read rad)
-
-manhattan :: Position -> Position -> Int
-manhattan (x1, y1, z1) (x2, y2, z2) = abs (x1 - x2) + abs (y1 - y2) + abs (z1 - z2)
-
--- botInRange b1 b2 = is b2 within the range of b1?
-botInRange :: Bot -> Bot -> Bool
-botInRange (Bot pos1 radius) (Bot pos2 _) = manhattan pos1 pos2 <= radius
-
--- inRange pos bot = is pos within the range of bot?
-inRange :: Bot -> Position -> Bool
-inRange (Bot bPos radius) pos = manhattan bPos pos <= radius
+    let pos = read $ "(" ++ (takeWhile (/= '>') . drop 5 $ str) ++ ")"
+        r = read . drop 2 . last . words $ str
+    in  Bot pos r
 
 part1 :: [Bot] -> Int
 part1 bots =
     let maxBot = maximum bots
     in  length $ filter (botInRange maxBot) bots
+    where botInRange (Bot pos1 r) (Bot pos2 _) = manhattan pos1 pos2 <= r
+
+
+-- Part 2 --
+
+data SBot = SBot SPosition SRadius
+type SPosition = (SInteger, SInteger, SInteger)
+type SRadius = SInteger
+
+botToSBot :: Bot -> SBot
+botToSBot (Bot (x, y, z) r) = SBot (literal x, literal y, literal z) (literal r)
+
+problem :: [SBot] -> Goal
+problem bots = do
+    [x, y, z] <- sIntegers ["x", "y", "z"]
+    maximize "bots" $ (inRangeOfBots (x, y, z) bots      :: SInteger)
+    minimize "dist" $ (manhattan     (x, y, z) (0, 0, 0) :: SInteger)
+    where
+        inRangeOfBots pos = sum . map (oneIf . inRangeOfBot pos)
+        inRangeOfBot  pos (SBot bPos r) = manhattan bPos pos .<= r
+
+part2 :: [SBot] -> IO OptimizeResult
+part2 = optimize Lexicographic . problem
+
+
+-- main --
 
 main :: IO ()
 main = do
     bots <- map parse . lines <$> readFile "input/23.txt"
+    let sbots = map botToSBot bots
     print $ part1 bots
+    part2 sbots >>= print

stack.yaml

@@ -38,7 +38,10 @@ packages:
 # Dependency packages to be pulled from upstream that are not in the resolver
 # using the same syntax as the packages field.
 # (e.g., acme-missiles-0.3)
-# extra-deps: []
+extra-deps:
+  - sbv-7.12
+  - crackNum-2.3
+  - FloatingHex-0.4
 
 # Override default flag values for local packages and extra-deps
 # flags: {}