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

haskell: 2023 10 refactor

Browse source
This commit is contained in:
Maciej Jur 2023-12-12 21:27:45 +01:00
parent 8a504e5a89
commit 5d753d5fbd
Signed by: kamov
GPG key ID: 191CBFF5F72ECAFD
1 changed files with 32 additions and 25 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

57
2023/haskell/solutions/Day10.hs
View file

@ -4,7 +4,7 @@ module Day10 where
import Data.Void (Void) import Data.Void (Void)
import Data.Text (Text) import Data.Text (Text)
import Data.Char (isSpace) import Data.Char (isSpace)
import Data.Maybe (mapMaybe) import Data.Maybe (mapMaybe, catMaybes)
import Data.Bifunctor (first, bimap) import Data.Bifunctor (first, bimap)
import Control.Monad (join) import Control.Monad (join)
import Text.Megaparsec (Parsec, errorBundlePretty, runParser, many, eof, satisfy) import Text.Megaparsec (Parsec, errorBundlePretty, runParser, many, eof, satisfy)
@ -23,7 +23,7 @@ data Pipe
| F -- down-right | F -- down-right
deriving (Show, Eq) deriving (Show, Eq)
data Dir = DLeft | DRight | DUp | DDown data Dir = DirL | DirR | DirU | DirD
deriving (Show, Eq) deriving (Show, Eq)
type Row = Int type Row = Int
@ -60,35 +60,42 @@ get (r, c) = snd . head . filter ((c ==) . fst) . zip [0..] . snd . head . filte
nextD :: Dir -> Pipe -> Maybe Dir nextD :: Dir -> Pipe -> Maybe Dir
nextD dir pipe = case (pipe, dir) of nextD dir pipe = case (pipe, dir) of
(I, DDown) -> Just DDown (I, DirD) -> Just DirD
(I, DUp) -> Just DUp (I, DirU) -> Just DirU
(H, DRight) -> Just DRight (H, DirR) -> Just DirR
(H, DLeft) -> Just DLeft (H, DirL) -> Just DirL
(J, DDown) -> Just DLeft (J, DirD) -> Just DirL
(J, DRight) -> Just DUp (J, DirR) -> Just DirU
(L, DDown) -> Just DRight (L, DirD) -> Just DirR
(L, DLeft) -> Just DUp (L, DirL) -> Just DirU
(T, DUp) -> Just DLeft (T, DirU) -> Just DirL
(T, DRight) -> Just DDown (T, DirR) -> Just DirD
(F, DUp) -> Just DRight (F, DirU) -> Just DirR
(F, DLeft) -> Just DDown (F, DirL) -> Just DirD
_ -> Nothing _ -> Nothing
nextC :: (Row, Col) -> Dir -> (Row, Col) nextC :: (Row, Col) -> Dir -> (Row, Col)
nextC (r, c) dir = case dir of nextC (r, c) dir = case dir of
DLeft -> (r, c - 1) DirL -> (r, c - 1)
DRight -> (r, c + 1) DirR -> (r, c + 1)
DUp -> (r - 1, c) DirU -> (r - 1, c)
DDown -> (r + 1, c) DirD -> (r + 1, c)
starts :: [[Pipe]] -> (Move, Move) starts :: [[Pipe]] -> (Move, Move)
starts grid = starts = do
let s = findStart grid sp <- findStart
ds = mapMaybe (\dir -> check dir $ nextC s dir) [ DUp, DDown, DLeft, DRight ] ds <- checkDirs sp
in (head ds, head $ tail ds) return (head ds, head $ tail ds)
where where
check :: Dir -> (Row, Col) -> Maybe Move check :: Dir -> (Row, Col) -> [[Pipe]] -> Maybe Move
check dir rc = fmap (const (dir, rc)) . nextD dir $ get rc grid check dir rc = fmap (const (dir, rc)) . nextD dir . get rc
checkDirs :: (Row, Col) -> [[Pipe]] -> [Move]
checkDirs sp = do
u <- check DirU $ nextC sp DirU
d <- check DirD $ nextC sp DirD
l <- check DirL $ nextC sp DirL
r <- check DirR $ nextC sp DirR
return $ catMaybes [u, d, l, r]
go :: [[Pipe]] -> (Dir, (Row, Col)) -> [(Dir, (Row, Col))] go :: [[Pipe]] -> (Dir, (Row, Col)) -> [(Dir, (Row, Col))]
go grid = helper go grid = helper