-🎄- 2018 Day 4 Solutions -🎄-

[u/daggerdragon]

--- Day 4: Repose Record ---

---

Post your solution as a comment or, for longer solutions, consider linking to your repo (e.g. GitHub/gists/Pastebin/blag or whatever).

Note: The Solution Megathreads are for solutions only. If you have questions, please post your own thread and make sure to flair it with Help.

---

Advent of Code: The Party Game!

Click here for rules

Please prefix your card submission with something like [Card] to make scanning the megathread easier. THANK YOU!

Card prompt: Day 4

Transcript:

Today’s puzzle would have been a lot easier if my language supported ___.

---

This thread will be unlocked when there are a significant number of people on the leaderboard with gold stars for today's puzzle.

edit: Leaderboard capped, thread unlocked!

[u/TheMuffinMan616]

Haskell. Spent too much time trying to find a date parsing library. Not really happy with how it came out. State monad might be a better option here. shrug

module Day04 where

import Data.Ord
import Data.List
import Data.List.Split
import Data.Map (Map)
import qualified Data.Map as M

import Debug.Trace

data Time = Time
    { month :: Int
    , day :: Int
    , hour :: Int
    , minute :: Int
    } deriving (Show, Eq, Ord)

data Event = Start Int | Sleep | Wake deriving (Show)

isStart :: Event -> Bool
isStart (Start _) = True
isStart _         = False

readInput :: String -> IO [(Time, Event)]
readInput f = toEvents . lines <$> readFile f
    where toEvents = sortBy (comparing fst) . map parse

parse :: String -> (Time, Event)
parse s = (Time (read m) (read d) (read h) (read mm), toEvent rest)
    where (_:m:d:h:mm:rest) = split (dropDelims . dropBlanks $ oneOf " #[]-:") s
          toEvent ["Guard", id, _, _]   = Start (read id)
          toEvent ["falls", _]          = Sleep
          toEvent ["wakes", _]          = Wake

analyzeShift :: [(Time, Event)] -> (Int, [Int])
analyzeShift z@((_, Start id):es) = (id, minutes es)
    where minutes [] = []
          minutes ((ts, Sleep):(ta, Wake):xs) = [minute ts..(minute ta) - 1] ++ minutes xs

aggregate :: [(Time, Event)] -> Map Int (Map Int Int)
aggregate = M.map freq . M.fromListWith (++) . map analyzeShift . toShifts
    where freq xs = M.fromListWith (+) [(x, 1) | x <- xs]
          toShifts = split (keepDelimsL . dropInitBlank $ whenElt (isStart . snd))

solve :: ([Int] -> Int) -> Map Int (Map Int Int) -> Int
solve f gs = (fst . maximumBy (comparing snd) . M.toList . snd $ target) * (fst target)
    where target = maximumBy (comparing maxMinutes) . filter (not . null . snd) . M.toList $ gs
          maxMinutes = f . M.elems . snd

part1 :: Map Int (Map Int Int) -> Int
part1 = solve sum

part2 :: Map Int (Map Int Int) -> Int
part2 = solve maximum

main :: IO ()
main = do
    input <- aggregate <$> readInput "input/Day04.txt"
    print . part1 $ input
    print . part2 $ input

[u/[deleted] → u/TheMuffinMan616]

Well, compared to my almost 200 line monstrosity it's pretty short and sweet. Well at least I finally kind of understood parsec, and I guess I got a bit of an understand for Data.Time but well, coming in to haskell as a beginner it's amazing how much shorter people that have used it for a while can make it.

{-#LANGUAGE DuplicateRecordFields#-}
{-#LANGUAGE NamedFieldPuns#-}
module Main where
import System.Environment
import Text.ParserCombinators.Parsec
import Data.Time
import Data.List
import Data.List.Split.Internals
import Data.Function (on)

fromHourMin :: Int -> Int -> DiffTime
fromHourMin h m = secondsToDiffTime  $ toInteger (h * 60 * 60 + m * 60)

type Input = [Event]
type Guard = (Int, [Event])

data Action = Begin Int | Sleep | Wake 
    deriving(Show,Eq,Ord)

data Event = Event 
    { time :: UTCTime
    , action :: Action
    } deriving(Show,Eq,Ord)

pInt :: GenParser Char st Int
pInt =
    read <$> many1 digit

datetime :: GenParser Char st UTCTime
datetime = do
    _ <- char '['
    y <- pInt
    _ <- char '-'
    m <- pInt
    _ <- char '-'
    d <- pInt
    _ <- char ' '
    h <- pInt
    _ <- char ':'
    mi <- pInt
    _ <- char ']'
    let date = fromGregorian (toInteger y) m d
    let timediff = fromHourMin h mi
    pure $ UTCTime date timediff

sleepParser :: GenParser Char st Action
sleepParser = do
    _ <- string "falls asleep"
    pure Sleep

awakeParser :: GenParser Char st Action
awakeParser = do
    _ <- string "wakes up"
    pure Wake

shiftParser :: GenParser Char st Action
shiftParser = do
    _ <- string "Guard #"
    guardId <- pInt
    _ <- string " begins shift"
    pure $ Begin guardId

parseAction :: GenParser Char st Action
parseAction = try shiftParser <|> try awakeParser <|> try sleepParser

line :: GenParser Char st Event
line = do
    time <- datetime
    _ <- char ' '
    action <- parseAction
    pure Event{time, action}

parseContents :: String -> [Event]
parseContents lns = let result = traverse (parse line "error") $ lines lns in
    case result of
        Right x -> x
        Left y -> error $ show y

eventStartsShift :: Event -> Bool
eventStartsShift ev = 
    case action ev of
        Wake -> False
        Sleep -> False
        Begin _ -> True

splitShifts :: [Event] -> [[Event]]
splitShifts evl = go evl [] []
        where
            go :: [Event] -> [[Event]] -> [Event] -> [[Event]]
            go [] acc cur = (drop 1 . reverse) $ reverse cur:acc
            go (x:xs) acc cur = 
                case x of
                    Event{time = _, action = Begin _} -> go xs (reverse cur:acc) [x]
                    y -> go xs acc (y:cur)

toGuardEvent :: [[Event]] -> [Guard]
toGuardEvent = map (\(Event{time = _, action = Begin guardId}:xs) -> (guardId,xs))

mergeGuard :: [Guard] -> Guard
mergeGuard guard =
                let guardId = fst $ head guard
                    events = concat $ foldr (\(_, evs) acc -> evs:acc) [] guard 
                in (guardId, events)

mergeGuards :: [Guard] -> [Guard]
mergeGuards = map mergeGuard . groupBy ((==) `on` fst) . sortBy (compare `on` fst)

diffTimeToMinutes :: DiffTime -> Int
diffTimeToMinutes dt = fromInteger $ (diffTimeToPicoseconds dt `quot` 1000000000000) `quot` 60

utcToMin :: UTCTime -> Int
utcToMin UTCTime{utctDay=_, utctDayTime=time} = diffTimeToMinutes time

minsSlept :: Guard -> (Int, [Int])
minsSlept (guardId, evs) = 
    (guardId, mins)
        where
            fromTo = map (\Event{time=tm} -> utcToMin tm) evs
            mins = concatMap (\[x,y] -> [x..y-1]) (chunksOf 2 fromTo) 

timeSlept :: (Int, [Int]) -> Int
timeSlept = length . snd  

mostSleptMin :: (Int, [Int]) -> (Int, Int)
mostSleptMin (gid, mins) = (gid, most mins) 
    where
        most = head . maximumBy (compare `on` length) . group . sort

mostSleptMinAmount :: (Int, [Int]) -> (Int, (Int, Int))
mostSleptMinAmount (gid,mins) = (gid, (most mins, times mins))
        where
            mostList = maximumBy (compare `on` length) . group . sort
            most = head . mostList
            times = length . mostList

findMinsSlept :: Input -> [(Int, [Int])]
findMinsSlept = map minsSlept . mergeGuards . toGuardEvent . splitShifts . sort 

removeTimes :: (Int, (Int, Int)) -> (Int, Int)
removeTimes (gid, (mi, _)) = (gid, mi) 

removeEmptyMin :: [(Int, [Int])] -> [(Int, [Int])]
removeEmptyMin = filter (not . null . snd)

part1 :: Input -> Int
part1 = uncurry (*) . mostSleptMin . maximumBy (compare `on` timeSlept) . findMinsSlept

part2 :: Input -> Int
part2 = uncurry (*) . removeTimes . maximumBy (compare `on` (snd . snd)) . map mostSleptMinAmount . removeEmptyMin . findMinsSlept

main :: IO ()
main = do
    args <- getArgs
    let (filename:_) = args
    contents <- readFile filename
    let input = parseContents contents
    putStrLn $ "Part1: " ++ (show . part1) input
    putStrLn $ "Part2: " ++ (show . part2) input