1
0
Fork 0

Day 04 - did some refactoring, but guardTimes can be written better.

This commit is contained in:
Jonathan Chan 2018-12-04 17:44:14 -08:00
parent 15e1fb4600
commit 49f211ca63
1 changed files with 38 additions and 37 deletions

View File

@ -1,57 +1,58 @@
module Day04 (main) where module Day04 (main) where
import Data.List (sort, groupBy, sortBy) import Data.List (sort, sortBy)
import Data.Text (Text, isInfixOf, pack, unpack) import Data.Ord (comparing)
import Data.Char (isDigit) import Data.Char (isDigit)
import Data.IntMap (fromListWith, toList) import Data.Text (Text, isInfixOf, pack, unpack, split)
import qualified Data.Text as T (lines)
import Data.IntMap (IntMap, fromListWith, toAscList, (!))
import qualified Data.IntMap as M (filter)
type Log = (Id, [Sleep]) -- Logs :: guard id => [minutes asleep]
type Id = Int type Logs = IntMap [Int]
type Sleep = [Minute]
type Minute = Int
(%) = mod (%) = mod
parse :: [String] -> [Log] getKeyWithMaxValBy :: Ord b => (a -> b) -> IntMap a -> (Int, a)
parse = map concatGuard . groupBy eqFst . sortBy compareFst . map (guardTimes . map unpack) . tail . splitByGuard [[]] . map pack getKeyWithMaxValBy f = head . sortBy (flip $ comparing (f . snd)) . toAscList
getIntWithMaxFreq :: [Int] -> (Int, Int)
getIntWithMaxFreq = getKeyWithMaxValBy id . fromListWith (+) . (flip zip) (repeat 1)
parse :: [String] -> Logs
parse input =
let partitioned :: [[String]] -- list of guards' lists of logs
partitioned = tail . map (map unpack . filter (not . isInfixOf (pack "Guard")) . T.lines) . split (== '#') . pack . unlines $ input
in fromListWith (++) . map guardTimes $ partitioned
where where
splitByGuard :: [[Text]] -> [Text] -> [[Text]] guardTimes :: [String] -> (Int, [Int])
splitByGuard (g:gs) [] = reverse ((reverse g):gs)
splitByGuard (g:gs) (e:es) =
if pack "Guard #" `isInfixOf` e
then splitByGuard ([e]:(reverse g):gs) es
else splitByGuard ((e:g):gs) es
guardTimes :: [String] -> Log
guardTimes (begin:logs) = guardTimes (begin:logs) =
let id = read . takeWhile isDigit . drop 26 $ begin :: Int let id = read . takeWhile isDigit $ begin
times = pair . map (parseTime . take 5 . drop 12) $ logs times = minutes . map (parseTime . take 5 . drop 12) $ logs
in (id, times) in (id, times)
parseTime :: String -> Int parseTime :: String -> Int
parseTime ('2':'3':_:m1:m2:[]) = read [m1, m2] parseTime ('2':'3':_:m1:m2:[]) = read [m1, m2]
parseTime ('0':'0':_:m1:m2:[]) = read [m1, m2] + 60 parseTime ('0':'0':_:m1:m2:[]) = read [m1, m2] + 60
pair :: [Int] -> [[Int]] minutes :: [Int] -> [Int]
pair [] = [] minutes [] = []
pair (s:w:xs) = ([s .. w - 1]:(pair xs)) minutes (s:w:xs) = [s .. w - 1] ++ (minutes xs)
compareFst :: Ord a => (a, b) -> (a, b) -> Ordering
compareFst t1 t2 = compare (fst t1) (fst t2)
eqFst :: Eq a => (a, b) -> (a, b) -> Bool
eqFst t1 t2 = (fst t1) == (fst t2)
concatGuard :: [Log] -> Log
concatGuard logs =
let id = fst . head $ logs
in (id, concat . map snd $ logs)
part1 :: [Log] -> Int part1 :: Logs -> Int
part1 logs = part1 logs =
let (id, _) = head . sortBy compareSndDesc . map (\(id, sleeps) -> (id, length . concat $ sleeps)) $ logs let guard = fst . getKeyWithMaxValBy id . fmap length $ logs
(_, sleeps) = head . filter ((== id) . fst) $ logs minute = (% 60) . fst . getIntWithMaxFreq $ logs ! guard
minute = (% 60) . fst . head . sortBy compareSndDesc . toList . fromListWith (+) $ zip (concat sleeps) (repeat 1) in guard * minute
in id * minute
where part2 :: Logs -> Int
compareSndDesc :: Ord b => (a, b) -> (a, b) -> Ordering part2 logs =
compareSndDesc t1 t2 = (flip compare) (snd t1) (snd t2) let idMinuteFreq :: IntMap (Int, Int) -- :: guard id => (most frequently asleep minute, frequency)
idMinuteFreq = fmap getIntWithMaxFreq . M.filter (not . null) $ logs
guard = fst . getKeyWithMaxValBy snd $ idMinuteFreq
minute = (% 60) . fst $ idMinuteFreq ! guard
in guard * minute
main :: IO () main :: IO ()
main = do main = do
input <- parse . sort . lines <$> readFile "input/04.txt" input <- parse . sort . lines <$> readFile "input/04.txt"
print $ part1 input print $ part1 input
print $ part2 input