~rootmos/AoC

e34d519860c222e57b783b94a241b0441a651ab9 — Gustav Behm 1 year, 4 months ago 25d8ad4
Add solution to AoC 2022 #15ab
1 files changed, 21 insertions(+), 31 deletions(-)

M 2022/15.hs
M 2022/15.hs => 2022/15.hs +21 -31
@@ 5,7 5,7 @@
{-# LANGUAGE NoImplicitPrelude #-}
module Main where

import Qulude hiding ( rotate )
import Qulude

--import Data.Array ( (!) )
import qualified Data.Array as Array


@@ 40,40 40,30 @@ parser = many sensor
dist :: Point -> Point -> Int
dist (x0,y0) (x1,y1) = abs (x1 - x0) + abs (y1 - y0)

isCovered :: Point -> Sensor -> Bool
isCovered p (s, b) = dist s p <= dist s b
f y (s@(sx,sy), b) = if h > d then Nothing else Just $ (sx - l, sx + l + 1)
  where d = dist s b
        h = abs (sy - y)
        l = d - h

bounds :: [ Sensor ] -> Maybe (Point, Point)
bounds [] = Nothing
bounds ((s@(x,y),b):ss) =
  let t = dist s b in
  let ((x0,y0), (x1,y1)) = ((x-t,y-t),(x+t,y+t)) in
  case bounds ss of
    Nothing -> Just ((x0,y0), (x1,y1))
    Just ((x0',y0'), (x1',y1')) ->
      Just ((min x0 x0', min y0 y0'), (max x1 x1', max y1 y1'))
k y = List.sortOn fst . catMaybes . fmap (f y)

partA y ss = let Just ((x0,_),(x1,_)) = bounds ss in count [ check (x, y) | x <- [x0..x1] ]
 where check p = or $ fmap (\s@(_,b) -> p /= b && isCovered p s) ss
partA y ss = let i:is = k y ss in g (-nbs) i is
  where g n (x,y) [] = n + (y-x)
        g n (x,y) ((x',y'):is) | x' <= y = g n (x,max y y') is
        g n (x,y) ((x',y'):is) | y < x' = g (n+y-x) (x',y') is
        bs = distinct $ fmap snd ss
        nbs = count $ fmap ((==) y . snd) bs

--partB m ss = head [ tf x y | x <- [0..m], y <- [0..m], check (x,y) ]
 --where check p = not $ or $ fmap (\s -> (isCovered p s)) ss
       --tf x y = x * 4000000 + y

rotate a (x, y) = (x*cos a - y*sin a, x*sin a + y*cos a)

partB _ ss = [ (f a b, a, b) | (a, _) <- ss, (b, _) <- ss ]
  where pi4 = pi / 4
        sq2 = sqrt 2 / 2
        t (x, y) = (fromIntegral x, fromIntegral y)
        f a b =
          let (rax, ray) = rotate pi4 (t a) in
          let (rbx, rby) = rotate pi4 (t b) in
          (round $ (rax - rbx)/sq2, round $ (ray - rby)/sq2)
partB m ss = g 0
  where g y = h y (k y ss)
        h y ((_,b):is) | b <= 0 = h y is
        h y ((_,b):_) | b > m = g (succ y)
        h y ((a,b):(a',b'):is) | b < a' = b * 4000000 + y
        h y ((a,b):(a',b'):is) | otherwise = h y $ (a, max b b'):is

main :: IO ()
main = with parser $ do
  run' "15.example" "a example" (partA 10) 26
  --run' "15.input" "a input" (partA 2000000) 5299855
  run "15.example" "b example" (partB 20)
  --run "15.input" "b input" (partB 4000000)
  run' "15.input" "a input" (partA 2000000) 5299855
  run' "15.example" "b example" (partB 20) 56000011
  run' "15.input" "b input" (partB 4000000) 13615843289729