2023: reformat Haskell

This commit is contained in:
eriedaberrie 2023-12-12 20:25:25 -08:00
parent 096ffa09d5
commit 7d34785a93
7 changed files with 48 additions and 34 deletions

View file

@ -1,3 +1,5 @@
{-# LANGUAGE TupleSections #-}
import Data.Char (isDigit, digitToInt) import Data.Char (isDigit, digitToInt)
import Data.Function (on) import Data.Function (on)
import Data.List (tails, findIndex, isPrefixOf, minimumBy) import Data.List (tails, findIndex, isPrefixOf, minimumBy)
@ -15,19 +17,19 @@ wordMap = [ ("one", 1)
, ("six", 6) , ("six", 6)
, ("seven", 7) , ("seven", 7)
, ("eight", 8) , ("eight", 8)
, ("nine", 9) , ("nine", 9)]
]
fullWordMap :: [(String, Int)] fullWordMap :: [(String, Int)]
fullWordMap = wordMap ++ (zip =<< map show) [1..9] fullWordMap = wordMap ++ (zip =<< map show) [1 .. 9]
opLineBasic :: LineOp opLineBasic :: LineOp
opLineBasic l = (combineDigits `on` ($ digitToInt <$> filter isDigit l)) head last opLineBasic l =
(combineDigits `on` ($ digitToInt <$> filter isDigit l)) head last
firstNumInLine :: String -> [(String, Int)] -> Int firstNumInLine :: String -> [(String, Int)] -> Int
firstNumInLine l = fst . minimumBy (compare `on` snd) . mapMaybe numIndex firstNumInLine l = fst . minimumBy (compare `on` snd) . mapMaybe numIndex
where where
numIndex (str, num) = (num,) <$> findIndex (isPrefixOf str) (tails l) numIndex (str, num) = (num, ) <$> findIndex (isPrefixOf str) (tails l)
opLineAdvanced :: LineOp opLineAdvanced :: LineOp
opLineAdvanced l = (combineDigits `on` uncurry firstNumInLine) opLineAdvanced l = (combineDigits `on` uncurry firstNumInLine)

View file

@ -8,9 +8,8 @@ getConsecutives = map length . filter ((== '#') . head) . group
allSprings :: String -> [String] allSprings :: String -> [String]
allSprings = foldr (liftA2 (:) . getChars) [""] allSprings = foldr (liftA2 (:) . getChars) [""]
where where
getChars c getChars '?' = ['.', '#']
| c == '?' = ['.', '#'] getChars c = [c]
| otherwise = [c]
solve :: [Int] -> String -> Int solve :: [Int] -> String -> Int
solve records = length . filter ((== records) . getConsecutives) . allSprings solve records = length . filter ((== records) . getConsecutives) . allSprings
@ -21,4 +20,5 @@ parseLine l = (map read . splitOn "," $ y, x)
(x:y:_) = splitOn " " l (x:y:_) = splitOn " " l
main :: IO () main :: IO ()
main = print . sum . map (uncurry solve . parseLine) . lines =<< readFile "data.txt" main = print . sum . map (uncurry solve . parseLine) . lines
=<< readFile "data.txt"

View file

@ -3,24 +3,35 @@ import Data.List (group, sort, sortOn)
import qualified Data.HashMap.Strict as HMS import qualified Data.HashMap.Strict as HMS
cardOrder :: HMS.HashMap Char Int cardOrder :: HMS.HashMap Char Int
cardOrder = HMS.fromList $ zip "AKQT98765432J" [0..] cardOrder = HMS.fromList . zip "AKQT98765432J" $ [0 ..]
getWorth :: String -> [Int] getWorth :: String -> [Int]
getWorth cards = handType : map (cardOrder HMS.!) cards getWorth cards = handType:map (cardOrder HMS.!) cards
where where
noJs = filter (/= 'J') cards noJs = filter (/= 'J') cards
jCount = 5 - length noJs jCount = 5 - length noJs
groupedCards = map length $ group $ sort noJs
groupedCards = map length . group . sort $ noJs
handType = case length groupedCards of handType = case length groupedCards of
0 -> 1 0 -> 1
1 -> 1 1 -> 1
2 -> if minimum groupedCards == 1 then 2 else 3 2 -> if minimum groupedCards == 1
3 -> if maximum groupedCards + jCount == 3 then 4 else 5 then 2
else 3
3 -> if maximum groupedCards + jCount == 3
then 4
else 5
4 -> 6 4 -> 6
5 -> 7 5 -> 7
solve :: [String] -> Int solve :: [String] -> Int
solve = sum . zipWith (*) [1..] . map snd . sortOn (map negate . getWorth . fst) . map parseLine solve = sum
. zipWith (*) [1 ..]
. map snd
. sortOn (map negate . getWorth . fst)
. map parseLine
where where
parseLine = second read . splitAt 5 parseLine = second read . splitAt 5

View file

@ -9,14 +9,14 @@ getDirection 'R' = snd
countTimes :: String -> DataMap -> Int countTimes :: String -> DataMap -> Int
countTimes directions m = countTimes' directions "AAA" 0 countTimes directions m = countTimes' directions "AAA" 0
where where
countTimes' (d:ds) s countTimes' _ "ZZZ" = id
| s == "ZZZ" = id countTimes' (d:ds) s = countTimes' ds (getDirection d $ m HMS.! s) . succ
| otherwise = countTimes' ds (getDirection d $ m HMS.! s) . succ
getDataMap :: [String] -> DataMap getDataMap :: [String] -> DataMap
getDataMap = HMS.fromList . map parseLine getDataMap = HMS.fromList . map parseLine
where where
get3At x = take 3 . drop x get3At x = take 3 . drop x
parseLine l = (get3At 0 l, (get3At 7 l, get3At 12 l)) parseLine l = (get3At 0 l, (get3At 7 l, get3At 12 l))
main :: IO () main :: IO ()

View file

@ -1,5 +1,5 @@
import qualified Data.HashMap.Strict as HMS
import Data.List (foldl1') import Data.List (foldl1')
import qualified Data.HashMap.Strict as HMS
type DataMap = HMS.HashMap String (String, String) type DataMap = HMS.HashMap String (String, String)
@ -10,9 +10,9 @@ getDirection 'R' = snd
countTimes :: String -> DataMap -> String -> Int countTimes :: String -> DataMap -> String -> Int
countTimes directions m start = countTimes' directions start 0 countTimes directions m start = countTimes' directions start 0
where where
countTimes' (d:ds) ss@(s:_) countTimes' _ ('Z':_) = id
| s == 'Z' = id countTimes' (d:ds) ss@(s:_) = countTimes' ds (getDirection d $ m HMS.! ss)
| otherwise = countTimes' ds (getDirection d $ m HMS.! ss) . succ . succ
solve :: String -> DataMap -> Int solve :: String -> DataMap -> Int
solve directions m = foldl1' lcm solve directions m = foldl1' lcm
@ -25,6 +25,7 @@ getDataMap :: [String] -> DataMap
getDataMap = HMS.fromList . map parseLine getDataMap = HMS.fromList . map parseLine
where where
get3At x = reverse . take 3 . drop x get3At x = reverse . take 3 . drop x
parseLine l = (get3At 0 l, (get3At 7 l, get3At 12 l)) parseLine l = (get3At 0 l, (get3At 7 l, get3At 12 l))
main :: IO () main :: IO ()