Part 2 done

This commit is contained in:
pingu 2024-12-08 14:45:24 +01:00
parent acb4341e9d
commit 27e4f9102b

View File

@ -1,11 +1,8 @@
{-# LANGUAGE LambdaCase, MultiWayIf #-}
{-# LANGUAGE MultiWayIf #-}
module Main where
import Data.Functor
import Data.Matrix hiding (trace)
import Data.List
import Numeric.Extra
import Debug.Trace
data Pos = Pos { ch :: Char
, ma :: Bool
@ -29,9 +26,6 @@ getMarked s = zip [1..] (toLists s) >>= \(y,l) -> zip [1..] l >>= \(x,c) ->
availableChars :: [Char]
availableChars = ['a'..'z'] ++ ['A'..'Z'] ++ ['0'..'9']
dist :: (Int,Int) -> (Int,Int) -> Float
dist (y,x) (y',x') = sqrt $ intToFloat (y-y')^2 + intToFloat (x-x')^2
line :: (Int,Int) -> (Int,Int) -> (Int,Int) -> Bool
line (y1,x1) (y2,x2) (y3,x3) =
if | x2 == x1 && x3 == x2 -> True
@ -47,14 +41,20 @@ combo ps = [(a,b) | a <- ps, b <- ps, a /= b]
getAntinodePos :: (Int,Int) -> [(Int,Int)] -> [(Int,Int)]
getAntinodePos (i,j) ps =
let inbounds (y,x) = and [0 < y, y <= i, 0 < x, x <= j] in
nub $ [ c | (p@(y,x),p'@(y',x')) <- combo ps,
[ c | (p@(y,x),p'@(y',x')) <- combo ps,
c <- [(y + (y-y'),x+(x-x')),
(y - (y-y'),x+(x-x')),
(y + (y-y'),x-(x-x')),
(y - (y-y'),x-(x-x'))],
(y - (y-y'),x+(x-x'))],
inbounds c,
line c p p']
getAntinodePos' :: (Int,Int) -> [(Int,Int)] -> [(Int,Int)]
getAntinodePos' (i,j) ps =
let inbounds (y,x) = and [0 < y, y <= i, 0 < x, x <= j]
a = combo ps >>= \((y,x),(y',x')) ->
takeWhile inbounds [ (y + step * (y - y'), x + step * (x - x')) | step <- [1..]]
b = combo ps >>= \((y,x),(y',x')) ->
takeWhile inbounds [ (y + step * (y - y'), x + step * (x - x')) | step <- [0,-1..]] in
a ++ b
mark :: Matrix Pos -> [(Int,Int)] -> Matrix Pos
mark = foldr (\p@(y,x) s -> let c = getElem y x s in setElem (c {ma = True}) p s)
@ -63,10 +63,11 @@ solve1 :: Matrix Pos -> Int
solve1 s = length . getMarked $
foldr (flip mark . getAntinodePos (nrows s, ncols s) . (`positionsOfChar` s)) s availableChars
solve2 = undefined
solve2 :: Matrix Pos -> Int
solve2 s = length . getMarked $
foldr (flip mark . getAntinodePos' (nrows s, ncols s) . (`positionsOfChar` s)) s availableChars
main :: IO ()
main = readFile "inputs/8.example" <&> parse >>= \i ->
print (solve1 i)
-- >>
-- print (solve2 i)
main = readFile "inputs/8" <&> parse >>= \i ->
print (solve1 i) >>
print (solve2 i)