eeva/advent-of-code-2024
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Day 10

Browse source
This commit is contained in:
Samae 2024-12-14 21:42:11 +02:00
parent 6515c6ec09
commit 51cb2314a8
6 changed files with 338 additions and 5 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
.gitignore vendored
View file

@ -3,3 +3,5 @@ result*
dist-newstyle dist-newstyle
*.eventlog *.eventlog
*.prof *.prof
*.dot
*.pdf

7
Main.hs
View file

@ -11,6 +11,7 @@ import Day6
import Day7 import Day7
import Day8 import Day8
import Day9 import Day9
import Day10
main :: IO () main :: IO ()
main = do main = do
@ -31,5 +32,7 @@ main = do
-- Day7.main -- Day7.main
-- putStrLn "Day 8" -- putStrLn "Day 8"
-- Day8.main -- Day8.main
putStrLn "Day 9" -- putStrLn "Day 9"
Day9.main -- Day9.main
putStrLn "Day 10"
Day10.main

4
flake.lock
View file

@ -3,8 +3,8 @@
"nixpkgs": { "nixpkgs": {
"locked": { "locked": {
"lastModified": 1, "lastModified": 1,
"narHash": "sha256-y/MEyuJ5oBWrWAic/14LaIr/u5E0wRVzyYsouYY3W6w=", "narHash": "sha256-AKU6qqskl0yf2+JdRdD0cfxX4b9x3KKV5RqA6wijmPM=",
"path": "/nix/store/zx63r1p2sg7w4vicnxlmh2assabvpzc7-c9wv7i0af6mysmy65x6nvyfw5izzxv4g-source", "path": "/nix/store/r06xpql4r58fkhzq6np83zhpm7gdmwjv-22r7q7s9552gn1vpjigkbhfgcvhsrz68-source",
"type": "path" "type": "path"
}, },
"original": { "original": {

54
inputs/day10.input Normal file
View file

@ -0,0 +1,54 @@
212521982345455432198898732343201001454321076767899872
101430671156766718089087001432102122367410789898721701
234549560049859809670106126549893432198523650127630652
345678432132343218543215437456784543007694540134544543
434989010101034567894326458941089656912784343296531014
123968523218954326287478947032178767843895256787432543
037879654305869210156565432142189626756706101208956632
010968760456778981432101943443076212389617890312347701
323459821678765476583201875654561003476526345423698801
011234734569012345694112766743432876565430256784510932
010345654554212014785073450898101986676321100898929841
143456703623103423456787321287632987685672901289838750
212769812514398512987896544379443456894589874356745669
301898453405487600121095434568543670123601065105210178
498782345654676321436784323877612589010892110234312321
567101908723521030545654012981003438756763323987603430
323877819810437841690343021542312321065654332109544543
014966521923456956781252120455401487654505445678037652
565455430810398105898763214345566590123218764789128781
678321876760567234237454905216697687689439653234569390
549050945651456340145667876107788014578321342106778434
432167834512301254206758989038979123065430211067884521
212058723003456763219843210123460132104321203458990690
103449012124567895430764505674321043895650432143021788
214530101013098986721256034985452344786766501032134659
345621232322121234890340125676965435689897865401235678
238789985421030345234543234767876105476101974321945234
129376576534781676167652149866765256785232389450876165
023403456215696787018967019875454343494341071265210074
016512567304345698101278112562343852014556780374391189
187876458412234598790349603401438961025698895489580543
098962389561103347685456784876547873234767216785671672
123451049870101256576545692910687210189854306894502981
212945432943232345677834501431296332182344345663213870
301876501854569431988925232321345345091103216756344561
676510345763078520123810123410543456780234109865432150
783401256762107019654320294567632109876542106776843001
892313879856234198734521287678932323438943769089987612
341054965447895287645632789456541010567659858123656543
250123832332196014532745610367692101298365647654567698
167814001541087123691821001298789854303234737843238787
078905123456789234780934789656730763214159826943129898
980876432965410165690695678749821278934067015652010789
801986501874321074321783265637832123653458234761001656
212567988965010787210654104521945034562109101891012347
123498677654321298323545003010876453078045610123456798
034014576103432186789276512123289342199236769032347810
145623985412545085652189467898100256787100898741016921
898767234307696198543011056967221105107231239653455430
745678101268987585654322343254339012218774381012768741
234989089456789676789113698107448763329783498019889650
101345674301410566541004567898758954458692567325676341
013216765210323455632123476127667763067501101234765432
322109876323454556789012981034554892155432101289876501

3
package.yaml
View file

@ -16,6 +16,7 @@ dependencies:
- linear - linear
- matrix - matrix
- parallel - parallel
- recursion-schemes
- safe - safe
- scientific - scientific
- split - split
@ -48,7 +49,7 @@ library:
- Day7 - Day7
- Day8 - Day8
- Day9 - Day9
# - Day10 - Day10
# - Day11 # - Day11
# - Day12 # - Day12
# - Day13 # - Day13

273
src/Day10.hs Normal file
View file

@ -0,0 +1,273 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# OPTIONS_GHC -Wno-orphans #-}
{-# OPTIONS_GHC -Wno-unused-imports #-}
module Day10 where
import qualified Algebra.Graph as D
import qualified Algebra.Graph.AdjacencyMap as A
import qualified Algebra.Graph.AdjacencyMap.Algorithm as A
import qualified Algebra.Graph.Class as C
import Algebra.Graph.Export
import Algebra.Graph.Export.Dot (exportViaShow)
import Algebra.Graph.ToGraph
import qualified Algebra.Graph.Undirected as U
import Data.Attoparsec.Text (Parser, digit, many1', parseOnly, sepBy, space)
import Data.Bifunctor (bimap)
import Data.Either (fromRight)
import qualified Data.Foldable as F
import Data.Functor.Base (TreeF (..))
import Data.Functor.Foldable
import Data.Map (Map)
import qualified Data.Map as M
import Data.Maybe (mapMaybe)
import Data.Monoid (Sum (..))
import Data.Set (Set)
import qualified Data.Set as S
import qualified Data.Text as T
import qualified Data.Text.IO as T
import qualified Data.Traversable as T
import qualified Data.Vector as V
import Debug.Trace
import GHC.Generics (Generic, Generic1)
type Pos = Int
type Height = Int
type Score = Sum Int
type NodeV = (Pos, Height)
type NodeVS = (Pos, Height, Score)
-- Recursion scheme thingies (why not?)
-- Isomorphic to Algebra.Graph.Graph
data GraF a b
= EmptyF
| VertexF a
| -- (V1, E1) + (V2, E2) = (V1 ∪ V2, E1 ∪ E2)
OverlayF b b
| -- (V1, E1) × (V2, E2) = (V1 ∪ V2, E1 ∪ E2 ∪ V1 × V2)
ConnectF b b
deriving
(Eq, Ord, Show, Read, Generic, Generic1, Functor, F.Foldable, T.Traversable)
type instance Base (D.Graph a) = GraF a
instance Recursive (D.Graph a) where
project D.Empty = EmptyF
project (D.Vertex v) = VertexF v
project (D.Overlay g1 g2) = OverlayF g1 g2
project (D.Connect g1 g2) = ConnectF g1 g2
instance Corecursive (D.Graph a) where
embed EmptyF = D.Empty
embed (VertexF v) = D.Vertex v
embed (OverlayF g1 g2) = D.Overlay g1 g2
embed (ConnectF g1 g2) = D.Connect g1 g2
-- Our own recursive Tree-like datatype
-- That type just happens to correspond to what adjacencyList returns!
newtype Treeish a = Treeish (a, [Treeish a])
-- I swear it's like a recursive Tree Functor
type instance Base (Treeish a) = TreeF a
-- Now the "hard" part
instance Recursive (Treeish a) where
project (Treeish (x, xs)) = NodeF x xs
instance Corecursive (Treeish a) where
embed (NodeF x xs) = Treeish (x, xs)
myShow :: (Show a) => D.Graph a -> String
myShow = para $ \case
EmptyF -> "ε"
VertexF v -> show v
OverlayF (D.Vertex v1, _) (D.Vertex v2, _) ->
"(" <> show v1 <> "+" <> show v2 <> ")"
OverlayF (_, g1) (_, g2) -> "(" <> g1 <> "---" <> g2 <> ")"
ConnectF (D.Vertex v1, _) (D.Vertex v2, _) ->
"<" <> show v1 <> "×" <> show v2 <> ">"
ConnectF (_, g1) (_, g2) -> "<" <> g1 <> " × " <> g2 <> ">"
legit :: D.Graph NodeV -> Bool
legit = para $ \case
EmptyF -> False
VertexF _v -> True
OverlayF (_, r1) (_, r2) -> r1 && r2
ConnectF (D.Vertex (_, h1), _) (D.Vertex (_, h2), _) -> h2 == h1 + 1
ConnectF (_, r1) (_, r2) -> r1 && r2
countStuff :: D.Graph NodeV -> Sum Int
countStuff g = foldMap go $ S.filter (\(_, h) -> h == 0) $ D.vertexSet g
where
go :: NodeV -> Sum Int
go v = Sum . length . filter (\(_, h) -> h == 9) $ reachable g v
-- Part B
countStuffB :: [(NodeV, [NodeV])] -> Int
countStuffB = extractSum . annotate10
annotate10 :: [(NodeV, [NodeV])] -> Map NodeV (Sum Int)
annotate10 xs =
annotate 0 xs -- ^
. annotate 1 xs -- |
. annotate 2 xs -- | Walk back
. annotate 3 xs -- | from height 9
. annotate 4 xs -- | to height 0
. annotate 5 xs -- |
. annotate 6 xs -- | counting how many
. annotate 7 xs -- | ways to get to 9
. annotate 8 xs -- |
. annotate 9 xs -- |
$ mempty
annotate ::
Height -> [(NodeV, [NodeV])] -> Map NodeV (Sum Int) -> Map NodeV (Sum Int)
annotate 9 xs _ =
M.fromList . map ((,Sum 1) . fst) . filter ((== 9) . snd . fst) $ xs
annotate h xs acc =
foldr go' acc . filter ((== h) . snd . fst) $ xs
where
go' :: (NodeV, [NodeV]) -> Map NodeV (Sum Int) -> Map NodeV (Sum Int)
go' (v, nx) =
M.insert v (F.fold $ M.restrictKeys acc (S.fromList nx))
extractSum :: Map NodeV (Sum Int) -> Int
extractSum = getSum . M.foldrWithKey go mempty
where
go :: NodeV -> Sum Int -> Sum Int -> Sum Int
go (_, 0) s acc = s <> acc
go _ _ acc = acc
-- From Algebra.Graph.*
showGraph ::
(Show a, Ord a, C.Graph g, ToGraph g, ToVertex g ~ a) => g -> String
showGraph = render . export vDoc eDoc
where
vDoc x = literal (show x) <> "\n"
eDoc x y = literal (show x) <> " - " <> literal (show y) <> "\n"
writeGraphOut ::
(Show a, Ord a, C.Graph g, ToGraph g, ToVertex g ~ a) => g -> IO ()
writeGraphOut = writeFile "graph.dot" . exportViaShow
-- "Newton" neighboring topology were two points from a 2D grid are neighbors
-- if they are on the same line or column (up,down,left,right)
-- (the name comes from http://mgs.lacl.fr/Online_Manual/Collections.html)
-- Pos is the indexing order from "bottom" to "top", "left" to "right"
--
-- Example for newtonNeighboring 3:
-- 6-7-8
-- | | | "4" has 4 neighbors [1,3,7,5]
-- 3-4-5 -> "2" has 2 neighbors [1,5]
-- | | | "7" has 3 neighbors [4,6,8]
-- 0-1-2
newtonNeighboring :: Int -> U.Graph Pos
newtonNeighboring n =
U.edges $
concatMap
( filter (\(x, x') -> x >= 0 && x < n2 && x' >= 0 && x' < n2)
. indexFromCoord
. coordFromIndex
)
[0 .. n2 - 1]
where
n2 = n * n
coordFromIndex :: Int -> [((Int, Int), (Int, Int))]
coordFromIndex i =
[ ((x, y), (x, y + 1)) -- up
, ((x, y), (x, y - 1)) -- down
, ((x, y), (x + 1, y)) -- right
, ((x, y), (x - 1, y)) -- left
]
where
x = i `mod` n
y = i `div` n
indexFromCoord :: [((Int, Int), (Int, Int))] -> [(Int, Int)]
indexFromCoord = mapMaybe go
where
go (c1, c2) = do
i1 <- c2i c1
i2 <- c2i c2
pure (i1, i2)
c2i (x, y) | x >= 0 && x < n = Just $ y * n + x
c2i _ = Nothing
parseInput :: Parser (Int, V.Vector Int)
parseInput = do
p <- many1' parseDigit `sepBy` space
let l = length . (!! 0) $ p
let v = V.fromList . concat $ p
pure (l, v)
parseDigit :: Parser Int
parseDigit = read . (: []) <$> digit
buildNewtonGraph :: Int -> V.Vector Int -> U.Graph (Pos, Int)
buildNewtonGraph n v = fmap setValue ng
where
ng = newtonNeighboring n
setValue :: Pos -> (Pos, Int)
setValue p = (p, v V.! p)
buildGraph :: T.Text -> D.Graph (Int, Int)
buildGraph txt = g'
where
(n, vals) =
fromRight (0, V.empty) . parseOnly parseInput . T.unlines . reverse . T.lines $
txt
g = U.fromUndirected $ buildNewtonGraph n vals
g' = D.edges (filter isHikingTrail $ D.edgeList g)
isHikingTrail ((_, v1), (_, v2)) = v2 == v1 + 1
solveB :: (Show a) => a -> a
solveB = undefined
inputEx :: T.Text
inputEx =
T.unlines
[ "89010123"
, "78121874"
, "87430965"
, "96549874"
, "45678903"
, "32019012"
, "01329801"
, "10456732"
]
otherInputEx :: T.Text
otherInputEx =
T.unlines
[ "1011911" -- 42 43 44 45 46 47 48
, "2111811" -- 35 36 37 38 39 40 41
, "3111711" -- 28 29 30 31 32 33 34
, "4567654" -- 21 22 23 24 25 26 27
, "1118113" -- 14 15 16 17 18 19 20
, "1119112" -- 07 08 09 10 11 12 13
, "1111101" -- 00 01 02 03 04 05 06
]
smallInputEx :: T.Text
smallInputEx =
T.unlines
[ "210" -- 06 07 08
, "121" -- 03 04 05
, "032" -- 00 01 02
]
main :: IO ()
main = do
input <- T.readFile "inputs/day10.input"
putStrLn "Part 1"
let g = buildGraph input
print . countStuff $ g
putStrLn "Part 2"
print . countStuffB $ D.adjacencyList g
-- print $ solveB input