108 lines
3.6 KiB
Haskell
108 lines
3.6 KiB
Haskell
import Data.List.Split (splitOn)
|
|
import qualified Data.Set as S
|
|
import Data.List (sortOn, sort)
|
|
import qualified Data.Map as M
|
|
import Debug.Trace (traceShowId)
|
|
import GHC.Utils.GlobalVars (global)
|
|
|
|
type Coord = (Int, Int)
|
|
|
|
globalY :: Int
|
|
globalY = 2000000
|
|
|
|
bound = 4000000
|
|
|
|
parseCoord :: String -> Coord
|
|
parseCoord xs = (read $ init x, read y) where
|
|
[x,y] = map (drop 2) $ splitOn " " xs
|
|
|
|
parseLine :: String -> (Coord, Coord)
|
|
parseLine xs = (sensor, beacon) where
|
|
[sensor, beacon] = map (parseCoord . dropWhile (/='x'))$ splitOn ":" xs
|
|
|
|
manhattan :: Coord -> Coord -> Int
|
|
manhattan (a,b) (x,y) = abs (a-x) + abs (b-y)
|
|
|
|
allWithinRange :: Coord -> Coord -> Int -> [Coord]
|
|
allWithinRange sensor@(a,b) beacon@(x,y) row = filter (\c -> manhattan sensor c <= dist) all where
|
|
minx = a - dist
|
|
maxx = a + dist
|
|
miny = b - dist
|
|
maxy = b + dist
|
|
dist = manhattan sensor beacon
|
|
all = [(x,row) | x <- [minx..maxx]]
|
|
|
|
closest :: Coord -> M.Map Coord Int -> Coord
|
|
closest coord beacons = closest -- manhattan coord closest > beacons M.! closest
|
|
where
|
|
closest = head $ sortOn (manhattan coord) (M.keys beacons)
|
|
|
|
scan :: M.Map Coord Int -> Coord -> Coord
|
|
scan dists progress@(x,y)
|
|
| outOfRange = progress
|
|
| x > bound = scan dists $ if y `mod` 1000 == 0 then traceShowId (0,y+1) else (0, y+1)
|
|
| y > bound = error "no beacon"
|
|
| x < fst near = scan dists (fst near + abs xdist, y)
|
|
| otherwise = scan dists (x+1, y)
|
|
where
|
|
near = closest progress dists
|
|
outOfRange = all (\(sensor, dist) -> manhattan sensor progress > dist) (M.toList dists)
|
|
xdist = x - fst near
|
|
next = if x < fst near then (fst near + xdist, y) else (x + 1, y)
|
|
|
|
bounds :: Coord -> Coord -> Int -> [(Int, Int)]
|
|
bounds sensor@(x,y) coord@(a,b) row = [(x - xdist, x + xdist) | ydist <= dist] where
|
|
dist = manhattan sensor coord
|
|
ydist = abs (y-row)
|
|
xdist = (dist - ydist)
|
|
|
|
mergeBounds :: [(Int, Int)] -> [(Int, Int)]
|
|
mergeBounds [x] = [x]
|
|
mergeBounds ((a,b):(x,y):xs)
|
|
| maxL >= minR - 1 = mergeBounds $ (minTot, maxTot):xs
|
|
| otherwise = [(a,b), (x,y)]
|
|
where
|
|
minL = min a b
|
|
maxL = max a b
|
|
minR = min x y
|
|
maxR = max x y
|
|
minTot = min minL minR
|
|
maxTot = max maxL maxR
|
|
|
|
traceCond :: (Int, Int) -> (Int, Int)
|
|
traceCond (x,y) = if x `mod` 1000 == 0 && y `mod` 1000 == 0 then traceShowId (x,y) else (x,y)
|
|
|
|
scan' :: [(Coord, Coord)] -> M.Map Coord Int -> Coord -> Coord
|
|
scan' input dists progress@(x,y)
|
|
| length covered == 1 && fst (head covered) <= 0 && snd (head covered) >= bound = scan' input dists $ traceCond (0, y+1)
|
|
| outOfRange = progress
|
|
| x > bound = scan' input dists $ traceShowId (0,y+1)
|
|
| y > bound = error "no beacon"
|
|
| otherwise = scan' input dists $ traceCond (x+1, y)
|
|
-- | x < fst near = scan' input dists $ traceShowId (fst near + abs xdist, y)
|
|
-- | otherwise = scan' input dists $ traceShowId (x+1, y)
|
|
where
|
|
covered = mergeBounds $ sort $ concatMap (\(s,b) -> bounds s b y) input
|
|
near = closest progress dists
|
|
outOfRange = all (\(sensor, dist) -> manhattan sensor progress > dist) (M.toList dists)
|
|
xdist = x - fst near
|
|
next = if x < fst near then (fst near + xdist, y) else (x + 1, y)
|
|
|
|
|
|
main :: IO ()
|
|
main = do
|
|
x <- map parseLine . lines <$> getContents
|
|
|
|
let beacons = S.fromList $ map snd x
|
|
let reachable = foldr1 S.union $ map (\(a,b) -> S.fromList $ allWithinRange a b globalY) x
|
|
|
|
let dists = M.fromList $ map (\(s,b) -> (s, manhattan s b)) x
|
|
|
|
let ys = S.size $ S.filter (\x -> snd x == globalY) (reachable S.\\ beacons)
|
|
|
|
-- putStr "part 1: "
|
|
-- print ys
|
|
|
|
putStr "part 2: "
|
|
let (x',y') = scan' x dists (0,3040754)
|
|
print $ y' + x'*4000000 |