pingu/aoc
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Part 2 done

Browse Source
This commit is contained in:
pingu 2024-12-08 14:45:24 +01:00
parent acb4341e9d
commit 27e4f9102b
1 changed files with 17 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

33
app/8.hs
View File

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