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:
|
||||
|
||||
-- LANGUAGE extensions used by modules in this package.
|
||||
-- other-extensions:
|
||||
|
||||
build-depends:
|
||||
|
@ -46,7 +45,6 @@ executable aoc2023
|
|||
other-modules:
|
||||
Utils
|
||||
|
||||
-- LANGUAGE extensions used by modules in this package.
|
||||
-- other-extensions:
|
||||
|
||||
build-depends:
|
||||
|
@ -61,13 +59,10 @@ executable aoc2023
|
|||
test-suite aoc2023-test
|
||||
import: warnings
|
||||
|
||||
-- Modules included in this executable, other than Main.
|
||||
-- other-modules:
|
||||
|
||||
-- LANGUAGE extensions used by modules in this package.
|
||||
-- other-extensions:
|
||||
|
||||
-- The interface type and version of the test suite.
|
||||
type: exitcode-stdio-1.0
|
||||
|
||||
hs-source-dirs: tests
|
||||
|
|
|
@ -37,16 +37,15 @@ parse = first errorBundlePretty . runParser full ""
|
|||
full :: Parser [[Item]]
|
||||
full = many line <* eof
|
||||
|
||||
findSpans :: (a -> a -> Bool) -> [a] -> [[a]]
|
||||
findSpans = helper []
|
||||
spansBy :: (a -> a -> Bool) -> [a] -> [[a]]
|
||||
spansBy p = helper []
|
||||
where
|
||||
helper :: [[a]] -> (a -> a -> Bool) -> [a] -> [[a]]
|
||||
helper acc _ [] = reverse . map reverse $ acc
|
||||
helper [] p (x:xs) = helper [[x]] p xs
|
||||
helper acc@(a:as) p (x:xs) =
|
||||
helper acc [] = reverse . map reverse $ acc
|
||||
helper [] (x:xs) = helper [[x]] xs
|
||||
helper acc@(a:as) (x:xs) =
|
||||
if p (head a) x
|
||||
then helper ((x:a):as) p xs
|
||||
else helper ([x]:acc) p xs
|
||||
then helper ((x:a):as) xs
|
||||
else helper ([x]:acc) xs
|
||||
|
||||
withCoords :: [[a]] -> [((Row, Col), a)]
|
||||
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
|
||||
in (n, (r, s, e))
|
||||
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 (r, s, e) = [(r, s-1), (r, e+1)]
|
||||
|
|
|
@ -6,11 +6,11 @@ import Data.Char (isDigit, digitToInt)
|
|||
import Data.Text (Text)
|
||||
import Data.List (sort, find, sortBy)
|
||||
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.Char (alphaNumChar, space)
|
||||
import Text.Megaparsec.Char.Lexer (decimal)
|
||||
import Control.Monad (join)
|
||||
|
||||
|
||||
data Card = X | Plain Int | T | J | Q | K | A
|
||||
|
@ -30,8 +30,8 @@ parse = first errorBundlePretty . runParser plays ""
|
|||
where
|
||||
card :: Char -> Card
|
||||
card c
|
||||
| isDigit c = Plain $ digitToInt c
|
||||
| otherwise = read $ pure c
|
||||
| isDigit c = Plain . digitToInt $ c
|
||||
| otherwise = read . pure $ c
|
||||
play :: Parser Play
|
||||
play = do
|
||||
cs <- map card <$> many alphaNumChar
|
||||
|
@ -43,48 +43,43 @@ parse = first errorBundlePretty . runParser plays ""
|
|||
plays = many play <* eof
|
||||
|
||||
spansBy :: (a -> a -> Bool) -> [a] -> [[a]]
|
||||
spansBy = helper []
|
||||
spansBy p = helper []
|
||||
where
|
||||
helper :: [[a]] -> (a -> a -> Bool) -> [a] -> [[a]]
|
||||
helper acc _ [] = reverse . map reverse $ acc
|
||||
helper [] p (x:xs) = helper [[x]] p xs
|
||||
helper acc@(a:as) p (x:xs) =
|
||||
helper acc [] = reverse . map reverse $ acc
|
||||
helper [] (x:xs) = helper [[x]] xs
|
||||
helper acc@(a:as) (x:xs) =
|
||||
if p (head a) x
|
||||
then helper ((x:a):as) p xs
|
||||
else helper ([x]:acc) p xs
|
||||
then helper ((x:a):as) xs
|
||||
else helper ([x]:acc) xs
|
||||
|
||||
group :: Hand -> [[Card]]
|
||||
group = spansBy (==) . sort
|
||||
|
||||
classify :: Hand -> HandType
|
||||
classify cs
|
||||
| has [5] = Five
|
||||
| has [4] = Four
|
||||
| has [3, 2] = Full
|
||||
| has [3] = Three
|
||||
| count 2 2 = TwoPair
|
||||
| has [2] = OnePair
|
||||
| otherwise = High
|
||||
classify = cast . sortBy (flip compare) . map length . group
|
||||
where
|
||||
sizes :: [Int]
|
||||
sizes = map length . group $ cs
|
||||
has :: [Int] -> Bool
|
||||
has = all (`elem` sizes)
|
||||
count :: Int -> Int -> Bool
|
||||
count n = (==) . length . filter (n==) $ sizes
|
||||
cast :: [Int] -> HandType
|
||||
cast ns = case ns of
|
||||
5:_ -> Five
|
||||
4:_ -> Four
|
||||
3:2:_ -> Full
|
||||
3:_ -> Three
|
||||
2:2:_ -> TwoPair
|
||||
2:_ -> OnePair
|
||||
_ -> High
|
||||
|
||||
withType :: Play -> (HandType, Play)
|
||||
withType = first (classify . fst) . join (,)
|
||||
withType :: (Hand -> HandType) -> Play -> (HandType, Play)
|
||||
withType toType = first (toType . fst) . join (,)
|
||||
|
||||
score :: Int -> Play -> Int
|
||||
score = flip $ (*) . snd
|
||||
|
||||
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 =
|
||||
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
|
||||
others = sortBy (flip compare `on` fst) . filter ((J /=) . snd) $ counts
|
||||
in case others of
|
||||
|
@ -99,8 +94,5 @@ erase e = helper
|
|||
| e == c = X : helper cs
|
||||
| otherwise = c : helper cs
|
||||
|
||||
withType' :: Play -> (HandType, Play)
|
||||
withType' = bimap (classify' . fst) (first (erase J)) . join (,)
|
||||
|
||||
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