haskell: 2023 10 refactor
This commit is contained in:
parent
5d753d5fbd
commit
b97721fa17
|
@ -1,12 +1,13 @@
|
|||
{-# LANGUAGE OverloadedStrings #-}
|
||||
module Day10 where
|
||||
module Day10 (parse, solveA, solveB) where
|
||||
|
||||
import Data.Void (Void)
|
||||
import Data.Text (Text)
|
||||
import Data.Char (isSpace)
|
||||
import Data.Maybe (mapMaybe, catMaybes)
|
||||
import Data.List (find)
|
||||
import Data.Maybe (mapMaybe, catMaybes, fromJust)
|
||||
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.Char (newline)
|
||||
import Misc (withCoords, pairs)
|
||||
|
@ -55,8 +56,10 @@ parse = first errorBundlePretty . runParser grid ""
|
|||
findStart :: [[Pipe]] -> (Row, Col)
|
||||
findStart = fst . head . filter ((S ==) . snd) . withCoords
|
||||
|
||||
get :: (Row, Col) -> [[Pipe]] -> Pipe
|
||||
get (r, c) = snd . head . filter ((c ==) . fst) . zip [0..] . snd . head . filter ((r ==) . fst) . zip [0..]
|
||||
get :: (Row, Col) -> [[Pipe]] -> Maybe Pipe
|
||||
get (r, c) = nth c <=< nth r
|
||||
where
|
||||
nth n = fmap snd . find ((n ==) . fst) . zip [0..]
|
||||
|
||||
nextD :: Dir -> Pipe -> Maybe Dir
|
||||
nextD dir pipe = case (pipe, dir) of
|
||||
|
@ -88,20 +91,20 @@ starts = do
|
|||
return (head ds, head $ tail ds)
|
||||
where
|
||||
check :: Dir -> (Row, Col) -> [[Pipe]] -> Maybe Move
|
||||
check dir rc = fmap (const (dir, rc)) . nextD dir . get rc
|
||||
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]
|
||||
u <- check DirU $ nextC sp DirU
|
||||
d <- check DirD $ nextC sp DirD
|
||||
return $ catMaybes [l, r, u, d]
|
||||
|
||||
go :: [[Pipe]] -> (Dir, (Row, Col)) -> [(Dir, (Row, Col))]
|
||||
go grid = helper
|
||||
where
|
||||
helper :: (Dir, (Row, Col)) -> [(Dir, (Row, Col))]
|
||||
helper (dir, rc) = (dir, rc) : case nextD dir $ get rc grid of
|
||||
helper (dir, rc) = (dir, rc) : case nextD dir . fromJust . get rc $ grid of
|
||||
Just dir' -> helper (dir', nextC rc dir')
|
||||
Nothing -> []
|
||||
|
||||
|
@ -121,8 +124,8 @@ verts grid = (findStart grid, findVerts grid)
|
|||
|
||||
-- https://en.wikipedia.org/wiki/Shoelace_formula
|
||||
-- A = ((x1 * y2 - y1 * x2) + (x2 * y3 - x3 * y2) + ...) / 2
|
||||
trapezoid :: ((Row, Col), [(Row, Col)]) -> Double
|
||||
trapezoid (sp, vs) = (/2) . fromIntegral . sum . map inner . pairs $ [sp] <> vs <> [sp]
|
||||
shoelace :: ((Row, Col), [(Row, Col)]) -> Double
|
||||
shoelace (sp, vs) = (/2) . fromIntegral . abs . sum . map inner . pairs $ [sp] <> vs <> [sp]
|
||||
where
|
||||
inner :: ((Row, Col), (Row, Col)) -> Int
|
||||
inner ((r1, c1), (r2, c2)) = r1 * c2 - r2 * c1
|
||||
|
@ -130,8 +133,8 @@ trapezoid (sp, vs) = (/2) . fromIntegral . sum . map inner . pairs $ [sp] <> vs
|
|||
-- https://en.wikipedia.org/wiki/Pick%27s_theorem
|
||||
-- A = i + b/2 - 1
|
||||
-- i = A - b/2 + 1
|
||||
interior :: ((Row, Col), [(Row, Col)]) -> Int -> Double
|
||||
interior vs path = abs $ trapezoid vs - fromIntegral path + 1
|
||||
|
||||
solveB :: [[Pipe]] -> Double
|
||||
solveB grid = interior (verts grid) (solveA grid)
|
||||
solveB = do
|
||||
vs <- verts
|
||||
hb <- solveA
|
||||
return $ shoelace vs - fromIntegral hb + 1
|
||||
|
|
|
@ -12,6 +12,7 @@ import qualified Day06
|
|||
import qualified Day07
|
||||
import qualified Day08
|
||||
import qualified Day09
|
||||
import qualified Day10
|
||||
|
||||
|
||||
day01 :: Test
|
||||
|
@ -210,17 +211,82 @@ day09 =
|
|||
\1 3 6 10 15 21\n\
|
||||
\10 13 16 21 30 45\n"
|
||||
|
||||
day10 :: Test
|
||||
day10 =
|
||||
let parsedA = Day10.parse inputA
|
||||
parsedB1 = Day10.parse inputB1
|
||||
parsedB2 = Day10.parse inputB2
|
||||
parsedB3 = Day10.parse inputB3
|
||||
parsedB4 = Day10.parse inputB4
|
||||
in TestList
|
||||
[ TestCase $ assertEqual "A" (Right 4) (Day10.solveA <$> parsedA)
|
||||
, TestCase $ assertEqual "B" (Right 4) (Day10.solveB <$> parsedB1)
|
||||
, TestCase $ assertEqual "B" (Right 4) (Day10.solveB <$> parsedB2)
|
||||
, TestCase $ assertEqual "B" (Right 8) (Day10.solveB <$> parsedB3)
|
||||
, TestCase $ assertEqual "B" (Right 10) (Day10.solveB <$> parsedB4)
|
||||
]
|
||||
where
|
||||
inputA =
|
||||
".....\n\
|
||||
\.S-7.\n\
|
||||
\.|.|.\n\
|
||||
\.L-J.\n\
|
||||
\.....\n"
|
||||
inputB1 =
|
||||
"...........\n\
|
||||
\.S-------7.\n\
|
||||
\.|F-----7|.\n\
|
||||
\.||.....||.\n\
|
||||
\.||.....||.\n\
|
||||
\.|L-7.F-J|.\n\
|
||||
\.|..|.|..|.\n\
|
||||
\.L--J.L--J.\n\
|
||||
\...........\n"
|
||||
inputB2 =
|
||||
"..........\n\
|
||||
\.S------7.\n\
|
||||
\.|F----7|.\n\
|
||||
\.||OOOO||.\n\
|
||||
\.||OOOO||.\n\
|
||||
\.|L-7F-J|.\n\
|
||||
\.|II||II|.\n\
|
||||
\.L--JL--J.\n\
|
||||
\..........\n"
|
||||
inputB3 =
|
||||
".F----7F7F7F7F-7....\n\
|
||||
\.|F--7||||||||FJ....\n\
|
||||
\.||.FJ||||||||L7....\n\
|
||||
\FJL7L7LJLJ||LJ.L-7..\n\
|
||||
\L--J.L7...LJS7F-7L7.\n\
|
||||
\....F-J..F7FJ|L7L7L7\n\
|
||||
\....L7.F7||L7|.L7L7|\n\
|
||||
\.....|FJLJ|FJ|F7|.LJ\n\
|
||||
\....FJL-7.||.||||...\n\
|
||||
\....L---J.LJ.LJLJ...\n"
|
||||
inputB4 =
|
||||
"FF7FSF7F7F7F7F7F---7\n\
|
||||
\L|LJ||||||||||||F--J\n\
|
||||
\FL-7LJLJ||||||LJL-77\n\
|
||||
\F--JF--7||LJLJ7F7FJ-\n\
|
||||
\L---JF-JLJ.||-FJLJJ7\n\
|
||||
\|F|F-JF---7F7-L7L|7|\n\
|
||||
\|FFJF7L7F-JF7|JL---7\n\
|
||||
\7-L-JL7||F7|L7F-7F7|\n\
|
||||
\L.L7LFJ|||||FJL7||LJ\n\
|
||||
\L7JLJL-JLJLJL--JLJ.L\n"
|
||||
|
||||
tests :: Test
|
||||
tests = TestList
|
||||
[ TestLabel "day01" day01
|
||||
, TestLabel "day02" day02
|
||||
, TestLabel "day03" day03
|
||||
, TestLabel "day04" day04
|
||||
, TestLabel "day05" day05
|
||||
, TestLabel "day06" day06
|
||||
, TestLabel "day07" day07
|
||||
, TestLabel "day08" day08
|
||||
, TestLabel "day09" day09
|
||||
[ TestLabel "01" day01
|
||||
, TestLabel "02" day02
|
||||
, TestLabel "03" day03
|
||||
, TestLabel "04" day04
|
||||
, TestLabel "05" day05
|
||||
, TestLabel "06" day06
|
||||
, TestLabel "07" day07
|
||||
, TestLabel "08" day08
|
||||
, TestLabel "09" day09
|
||||
, TestLabel "10" day10
|
||||
]
|
||||
|
||||
main :: IO ()
|
||||
|
|
Loading…
Reference in a new issue