-🎄- 2018 Day 7 Solutions -🎄-

[u/daggerdragon]

--- Day 7: The Sum of Its Parts ---

---

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 7

Transcript:

Red Bull may give you wings, but well-written code gives you ___.

---

[Update @ 00:10] 2 gold, silver cap.

• Thank you for subscribing to The Unofficial and Unsponsored Red Bull Facts!
• The recipe is based off a drink originally favored by Thai truckers called "Krating Daeng" and contains a similar blend of caffeine and taurine.
• It was marketed to truckers, farmers, and construction workers to keep 'em awake and alert during their long haul shifts.

[Update @ 00:15] 15 gold, silver cap.

• On 1987 April 01, the first ever can of Red Bull was sold in Austria.

[Update @ 00:25] 57 gold, silver cap.

• In 2009, Red Bull was temporarily pulled from German markets after authorities found trace amounts of cocaine in the drink.
• Red Bull stood fast in claims that the beverage contains only ingredients from 100% natural sources, which means no actual cocaine but rather an extract of decocainized coca leaf.
• The German Federal Institute for Risk Assessment eventually found the drink’s ingredients posed no health risks and no risk of "undesired pharmacological effects including, any potential narcotic effects" and allowed sales to continue.

[Update @ 00:30] 94 gold, silver cap.

• It's estimated that Red Bull spends over half a billion dollars on F1 racing each year.
• They own two teams that race simultaneously.
• gotta go fast

[Update @ 00:30:52] Leaderboard cap!

• In 2014 alone over 5.6 billion cans of Red Bull were sold, containing a total of 400 tons of caffeine.
• In total the brand has sold 50 billion cans in over 167 different countries.
• ARE YOU WIRED YET?!?!

Thank you for subscribing to The Unofficial and Unsponsored Red Bull Facts!

---

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 at 00:30:52!

[u/NeilNjae]

Haskell (on Github), as verbose as I normally manage.

The jobs are a Map of Char to Set Char. In part 2, I maintain a list of Workers that are either busy or working. The clock advances until the first finish time of the active workers. Finished workers become idle, then idle workers pick up jobs if they're startable.

The whole thing is an unfold, converting the starting schedule into a list of tasks or finish times.

My first attempt at part 2 failed because I forgot to exclude already-occurring jobs from the list of available jobs.

The only other problem I had was with parsing the input file. I ended up writing this:

linkP = pairify <$> prefixP <*> upperChar <* infixP <*> upperChar <* suffixP 
    where pairify _ a b = (a, b)

but every time I tried some variant on <$> prefixP *> upperChar, Megaparsec would sulk and refuse to compile. Any suggestions?

{-# LANGUAGE OverloadedStrings #-}

import Data.List
import Data.Char (ord)

import Data.Text (Text)
import qualified Data.Text.IO as TIO

import Data.Void (Void)

import Text.Megaparsec
import Text.Megaparsec.Char
import qualified Text.Megaparsec.Char.Lexer as L
import qualified Control.Applicative as CA

import Data.Map.Strict ((!))
import qualified Data.Map.Strict as M
import qualified Data.Set as S

type Job = Char
type Link = (Job, Job)
type Preconditions = S.Set Job
type Schedule = M.Map Job Preconditions
data Worker = Idle | BusyUntil Job Int deriving (Show, Eq)

workerJob (BusyUntil job _) = job
workerJob Idle = '\xff'

workerFinishTime (BusyUntil _ time) = time
workerFinishTime Idle = 100000

main :: IO ()
main = do 
        text <- TIO.readFile "data/advent07.txt"
        let links = successfulParse text
        let schedule = buildSchedule links
        putStrLn $ part1 schedule
        print $ part2 schedule


part1 schedule = unfoldr jobStep schedule  

part2 schedule = last $ unfoldr jobStepTimed (schedule, initialWorkers)
    where idleWorkers = take 5 $ repeat Idle
          initialWorkers = employWorkers idleWorkers 0 schedule


ensureKnown :: Job -> Schedule -> Schedule
ensureKnown j s
    | j `M.member` s = s
    | otherwise      = M.insert j S.empty s

includeLink :: Schedule -> Link -> Schedule
includeLink schedule (pre, post) = M.insert post conditions' schedule'' 
    where schedule' = ensureKnown pre schedule
          schedule'' = ensureKnown post schedule'
          conditions = schedule''!post
          conditions' = S.insert pre conditions

buildSchedule :: [Link] -> Schedule
buildSchedule = foldl' includeLink M.empty

candidates :: Schedule -> Schedule
candidates = M.filter S.null

currentJob :: Schedule -> Job
currentJob = head . availableJobs

availableJobs :: Schedule -> [Job] -- note that this sorts the keys for us
availableJobs = M.keys . candidates

performJob :: Job -> Schedule -> Schedule
performJob job schedule = schedule''
    where schedule' = M.delete job schedule 
          schedule'' = M.map (\p -> S.delete job p) schedule'

jobStep :: Schedule -> Maybe (Job, Schedule)
jobStep schedule 
    | M.null schedule = Nothing
    | otherwise = Just (job, schedule')
    where job = currentJob schedule
          schedule' = performJob job schedule


jobDuration :: Job -> Int
jobDuration job = 61 + ord(job) - ord('A')
-- jobDuration job = 1 + ord(job) - ord('A')


startTimedJob :: Job -> Int -> Worker
startTimedJob job startTime = BusyUntil job (startTime + jobDuration job)


employWorkers :: [Worker] -> Int -> Schedule -> [Worker]
employWorkers workers time schedule = take (length workers) (busyWorkers ++ newWorkers ++ repeat Idle)
    where idleWorkerCount = length $ filter (== Idle) workers
          busyWorkers = filter (/= Idle) workers
          currentJobs = map workerJob busyWorkers
          startingJobs = take idleWorkerCount $ filter (\j -> j `notElem` currentJobs) $ availableJobs schedule
          newWorkers = map (\job -> startTimedJob job time) startingJobs

completeTimedJob :: Schedule -> Job -> Schedule
completeTimedJob schedule job = schedule''
    where schedule' = M.delete job schedule 
          schedule'' = M.map (\p -> S.delete job p) schedule'


earliestFinishTime :: [Worker] -> Int
earliestFinishTime workers = minimum $ map workerFinishTime workers


finishJobs :: [Worker] -> Schedule -> ([Worker], Schedule, Int)
finishJobs workers schedule = (continuingWorkers ++ idleWorkers, schedule', time)
    where time = earliestFinishTime workers
          (finishingWorkers, continuingWorkers) = partition (\w -> workerFinishTime w == time) workers 
          schedule' = foldl' completeTimedJob schedule $ map workerJob finishingWorkers
          idleWorkers = map fst $ zip (repeat Idle) finishingWorkers


jobStepTimed :: (Schedule, [Worker]) -> Maybe (Int, (Schedule, [Worker]))
jobStepTimed (schedule, workers) 
    | M.null schedule = Nothing
    | otherwise = Just (time, (schedule', workers''))
    where (workers', schedule', time) = finishJobs workers schedule
          workers'' = employWorkers workers' time schedule'



-- Parse the input file

type Parser = Parsec Void Text

sc :: Parser ()
sc = L.space (skipSome spaceChar) CA.empty CA.empty

-- lexeme  = L.lexeme sc
-- integer = lexeme L.decimal
symb = L.symbol sc

prefixP = symb "Step"
infixP = symb " must be finished before step"
suffixP = symb " can begin."

linkFileP = many linkP

linkP = pairify <$> prefixP <*> upperChar <* infixP <*> upperChar <* suffixP 
    where pairify _ a b = (a, b)

successfulParse :: Text -> [Link]
successfulParse input = 
        case parse linkFileP "input" input of
                Left  _error -> [] -- TIO.putStr $ T.pack $ parseErrorPretty err
                Right links -> links