34 lines
1.2 KiB
Haskell
Executable File
34 lines
1.2 KiB
Haskell
Executable File
#! /usr/bin/env stack
|
|
-- stack --resolver lts-12.20 --install-ghc script
|
|
{-# LANGUAGE ViewPatterns #-}
|
|
module Main where
|
|
|
|
import Control.Arrow ((&&&))
|
|
import qualified Data.List as L
|
|
import qualified Data.Set as S
|
|
import qualified Data.Map as M
|
|
|
|
import Debug.Trace
|
|
|
|
main :: IO ()
|
|
main = interact $ show . simulate (-1) [] . parseInput
|
|
|
|
simulate :: Int -> [(Char, Int)] -> M.Map Char (S.Set Char) -> Int
|
|
simulate t ws depSets = traceShow (t, ws) $
|
|
if null ws && M.null depSets then t
|
|
else simulate (t+1) ws'' depSets''
|
|
where
|
|
(ws', S.fromList . fmap fst -> finished) =
|
|
L.partition ((> 0) . snd) $ fmap (fmap (subtract 1)) ws
|
|
depSets' = M.map (`S.difference` finished) depSets
|
|
starting = take (5 - length ws') . L.sort . M.keys . M.filter S.null $ depSets'
|
|
stepTime c = 60 + (fromEnum c - fromEnum 'A' + 1)
|
|
ws'' = ws' ++ fmap (id &&& stepTime) starting
|
|
depSets'' = flip (foldr M.delete) starting depSets'
|
|
|
|
parseInput :: String -> M.Map Char (S.Set Char)
|
|
parseInput = M.unionsWith (<>) . fmap parseLine . lines
|
|
where
|
|
parseLine (words -> (_:(req:_):_:_:_:_:_:(step:_):_)) =
|
|
M.fromList [(req, S.empty), (step, S.singleton req)]
|