haskell: 2023 07 cleanup
This commit is contained in:
parent
c0962f9acd
commit
24f1b8a2d1
1000
2023/.inputs/07
Normal file
1000
2023/.inputs/07
Normal file
File diff suppressed because it is too large
Load diff
|
@ -28,7 +28,6 @@ library
|
||||||
|
|
||||||
-- other-modules:
|
-- other-modules:
|
||||||
|
|
||||||
-- LANGUAGE extensions used by modules in this package.
|
|
||||||
-- other-extensions:
|
-- other-extensions:
|
||||||
|
|
||||||
build-depends:
|
build-depends:
|
||||||
|
@ -46,7 +45,6 @@ executable aoc2023
|
||||||
other-modules:
|
other-modules:
|
||||||
Utils
|
Utils
|
||||||
|
|
||||||
-- LANGUAGE extensions used by modules in this package.
|
|
||||||
-- other-extensions:
|
-- other-extensions:
|
||||||
|
|
||||||
build-depends:
|
build-depends:
|
||||||
|
@ -61,13 +59,10 @@ executable aoc2023
|
||||||
test-suite aoc2023-test
|
test-suite aoc2023-test
|
||||||
import: warnings
|
import: warnings
|
||||||
|
|
||||||
-- Modules included in this executable, other than Main.
|
|
||||||
-- other-modules:
|
-- other-modules:
|
||||||
|
|
||||||
-- LANGUAGE extensions used by modules in this package.
|
|
||||||
-- other-extensions:
|
-- other-extensions:
|
||||||
|
|
||||||
-- The interface type and version of the test suite.
|
|
||||||
type: exitcode-stdio-1.0
|
type: exitcode-stdio-1.0
|
||||||
|
|
||||||
hs-source-dirs: tests
|
hs-source-dirs: tests
|
||||||
|
|
|
@ -37,16 +37,15 @@ parse = first errorBundlePretty . runParser full ""
|
||||||
full :: Parser [[Item]]
|
full :: Parser [[Item]]
|
||||||
full = many line <* eof
|
full = many line <* eof
|
||||||
|
|
||||||
findSpans :: (a -> a -> Bool) -> [a] -> [[a]]
|
spansBy :: (a -> a -> Bool) -> [a] -> [[a]]
|
||||||
findSpans = helper []
|
spansBy p = helper []
|
||||||
where
|
where
|
||||||
helper :: [[a]] -> (a -> a -> Bool) -> [a] -> [[a]]
|
helper acc [] = reverse . map reverse $ acc
|
||||||
helper acc _ [] = reverse . map reverse $ acc
|
helper [] (x:xs) = helper [[x]] xs
|
||||||
helper [] p (x:xs) = helper [[x]] p xs
|
helper acc@(a:as) (x:xs) =
|
||||||
helper acc@(a:as) p (x:xs) =
|
|
||||||
if p (head a) x
|
if p (head a) x
|
||||||
then helper ((x:a):as) p xs
|
then helper ((x:a):as) xs
|
||||||
else helper ([x]:acc) p xs
|
else helper ([x]:acc) xs
|
||||||
|
|
||||||
withCoords :: [[a]] -> [((Row, Col), a)]
|
withCoords :: [[a]] -> [((Row, Col), a)]
|
||||||
withCoords grid = [((r, c), a) | (r, row) <- zip [0..] grid, (c, a) <- zip [0..] row]
|
withCoords grid = [((r, c), a) | (r, row) <- zip [0..] grid, (c, a) <- zip [0..] row]
|
||||||
|
@ -75,7 +74,7 @@ getNumbers = concat . zipWith processRow [0..]
|
||||||
e = maximum $ map fst items
|
e = maximum $ map fst items
|
||||||
in (n, (r, s, e))
|
in (n, (r, s, e))
|
||||||
processRow :: Row -> [Item] -> [(Int, (Row, Col, Col))]
|
processRow :: Row -> [Item] -> [(Int, (Row, Col, Col))]
|
||||||
processRow r = map (merge r) . findSpans isNext . mapMaybe getDigit . zip [0..]
|
processRow r = map (merge r) . spansBy isNext . mapMaybe getDigit . zip [0..]
|
||||||
|
|
||||||
getNeigbors :: (Row, Col, Col) -> [(Row, Col)]
|
getNeigbors :: (Row, Col, Col) -> [(Row, Col)]
|
||||||
getNeigbors (r, s, e) = [(r, s-1), (r, e+1)]
|
getNeigbors (r, s, e) = [(r, s-1), (r, e+1)]
|
||||||
|
|
|
@ -6,11 +6,11 @@ import Data.Char (isDigit, digitToInt)
|
||||||
import Data.Text (Text)
|
import Data.Text (Text)
|
||||||
import Data.List (sort, find, sortBy)
|
import Data.List (sort, find, sortBy)
|
||||||
import Data.Function (on)
|
import Data.Function (on)
|
||||||
import Data.Bifunctor (first, Bifunctor (bimap))
|
import Data.Bifunctor (first, bimap, second)
|
||||||
|
import Control.Monad (join)
|
||||||
import Text.Megaparsec (Parsec, errorBundlePretty, runParser, many, eof)
|
import Text.Megaparsec (Parsec, errorBundlePretty, runParser, many, eof)
|
||||||
import Text.Megaparsec.Char (alphaNumChar, space)
|
import Text.Megaparsec.Char (alphaNumChar, space)
|
||||||
import Text.Megaparsec.Char.Lexer (decimal)
|
import Text.Megaparsec.Char.Lexer (decimal)
|
||||||
import Control.Monad (join)
|
|
||||||
|
|
||||||
|
|
||||||
data Card = X | Plain Int | T | J | Q | K | A
|
data Card = X | Plain Int | T | J | Q | K | A
|
||||||
|
@ -30,8 +30,8 @@ parse = first errorBundlePretty . runParser plays ""
|
||||||
where
|
where
|
||||||
card :: Char -> Card
|
card :: Char -> Card
|
||||||
card c
|
card c
|
||||||
| isDigit c = Plain $ digitToInt c
|
| isDigit c = Plain . digitToInt $ c
|
||||||
| otherwise = read $ pure c
|
| otherwise = read . pure $ c
|
||||||
play :: Parser Play
|
play :: Parser Play
|
||||||
play = do
|
play = do
|
||||||
cs <- map card <$> many alphaNumChar
|
cs <- map card <$> many alphaNumChar
|
||||||
|
@ -43,48 +43,43 @@ parse = first errorBundlePretty . runParser plays ""
|
||||||
plays = many play <* eof
|
plays = many play <* eof
|
||||||
|
|
||||||
spansBy :: (a -> a -> Bool) -> [a] -> [[a]]
|
spansBy :: (a -> a -> Bool) -> [a] -> [[a]]
|
||||||
spansBy = helper []
|
spansBy p = helper []
|
||||||
where
|
where
|
||||||
helper :: [[a]] -> (a -> a -> Bool) -> [a] -> [[a]]
|
helper acc [] = reverse . map reverse $ acc
|
||||||
helper acc _ [] = reverse . map reverse $ acc
|
helper [] (x:xs) = helper [[x]] xs
|
||||||
helper [] p (x:xs) = helper [[x]] p xs
|
helper acc@(a:as) (x:xs) =
|
||||||
helper acc@(a:as) p (x:xs) =
|
|
||||||
if p (head a) x
|
if p (head a) x
|
||||||
then helper ((x:a):as) p xs
|
then helper ((x:a):as) xs
|
||||||
else helper ([x]:acc) p xs
|
else helper ([x]:acc) xs
|
||||||
|
|
||||||
group :: Hand -> [[Card]]
|
group :: Hand -> [[Card]]
|
||||||
group = spansBy (==) . sort
|
group = spansBy (==) . sort
|
||||||
|
|
||||||
classify :: Hand -> HandType
|
classify :: Hand -> HandType
|
||||||
classify cs
|
classify = cast . sortBy (flip compare) . map length . group
|
||||||
| has [5] = Five
|
|
||||||
| has [4] = Four
|
|
||||||
| has [3, 2] = Full
|
|
||||||
| has [3] = Three
|
|
||||||
| count 2 2 = TwoPair
|
|
||||||
| has [2] = OnePair
|
|
||||||
| otherwise = High
|
|
||||||
where
|
where
|
||||||
sizes :: [Int]
|
cast :: [Int] -> HandType
|
||||||
sizes = map length . group $ cs
|
cast ns = case ns of
|
||||||
has :: [Int] -> Bool
|
5:_ -> Five
|
||||||
has = all (`elem` sizes)
|
4:_ -> Four
|
||||||
count :: Int -> Int -> Bool
|
3:2:_ -> Full
|
||||||
count n = (==) . length . filter (n==) $ sizes
|
3:_ -> Three
|
||||||
|
2:2:_ -> TwoPair
|
||||||
|
2:_ -> OnePair
|
||||||
|
_ -> High
|
||||||
|
|
||||||
withType :: Play -> (HandType, Play)
|
withType :: (Hand -> HandType) -> Play -> (HandType, Play)
|
||||||
withType = first (classify . fst) . join (,)
|
withType toType = first (toType . fst) . join (,)
|
||||||
|
|
||||||
score :: Int -> Play -> Int
|
score :: Int -> Play -> Int
|
||||||
score = flip $ (*) . snd
|
score = flip $ (*) . snd
|
||||||
|
|
||||||
solveA :: [Play] -> Int
|
solveA :: [Play] -> Int
|
||||||
solveA = sum . zipWith score [1..] . map snd . sort . map withType
|
solveA = sum . zipWith score [1..] . map snd . sort . map (withType classify)
|
||||||
|
|
||||||
classify' :: [Card] -> HandType
|
classify' :: Hand -> HandType
|
||||||
classify' cs =
|
classify' cs =
|
||||||
let counts = map (bimap length head . join (,)) . spansBy (==) . sort $ cs
|
let counts = map (bimap length head . join (,)) . group $ cs
|
||||||
jokers = maybe 0 fst . find ((J ==) . snd) $ counts
|
jokers = maybe 0 fst . find ((J ==) . snd) $ counts
|
||||||
others = sortBy (flip compare `on` fst) . filter ((J /=) . snd) $ counts
|
others = sortBy (flip compare `on` fst) . filter ((J /=) . snd) $ counts
|
||||||
in case others of
|
in case others of
|
||||||
|
@ -99,8 +94,5 @@ erase e = helper
|
||||||
| e == c = X : helper cs
|
| e == c = X : helper cs
|
||||||
| otherwise = c : helper cs
|
| otherwise = c : helper cs
|
||||||
|
|
||||||
withType' :: Play -> (HandType, Play)
|
|
||||||
withType' = bimap (classify' . fst) (first (erase J)) . join (,)
|
|
||||||
|
|
||||||
solveB :: [Play] -> Int
|
solveB :: [Play] -> Int
|
||||||
solveB = sum . zipWith score [1..] . map snd . sort . map withType'
|
solveB = sum . zipWith score [1..] . map snd . sort . map (second (first $ erase J) . withType classify')
|
||||||
|
|
Loading…
Reference in a new issue