From 3d3559bb38eb55055fc04821f046852c64e3dead Mon Sep 17 00:00:00 2001 From: Jonathan Chan Date: Sun, 23 Dec 2018 22:08:06 -0800 Subject: [PATCH] Day 22 - fixed part 2 (Visiteds should save Key, not just Coordinate); Day 23 - part 2 using SBV (but runs very slowly). --- README.md | 6 +++--- app/Main.hs | 2 +- package.yaml | 1 + src/Day22.hs | 20 +++++++++--------- src/Day23.hs | 59 +++++++++++++++++++++++++++++++++++++--------------- stack.yaml | 5 ++++- 6 files changed, 61 insertions(+), 32 deletions(-) diff --git a/README.md b/README.md index 2b866df..dc1e406 100644 --- a/README.md +++ b/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 | | diff --git a/app/Main.hs b/app/Main.hs index 26623c4..a4e8d2b 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -30,4 +30,4 @@ import qualified Day24 import qualified Day25 main :: IO () -main = Day23.main +main = Day24.main diff --git a/package.yaml b/package.yaml index 0c38a01..c322e7d 100644 --- a/package.yaml +++ b/package.yaml @@ -28,6 +28,7 @@ dependencies: - vector - array - parsec +- sbv library: source-dirs: src diff --git a/src/Day22.hs b/src/Day22.hs index d33c6fa..b75db99 100644 --- a/src/Day22.hs +++ b/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 () diff --git a/src/Day23.hs b/src/Day23.hs index 9325bf4..67a98c1 100644 --- a/src/Day23.hs +++ b/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 diff --git a/stack.yaml b/stack.yaml index c59e61f..8427099 100644 --- a/stack.yaml +++ b/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: {}