never executed always true always false
    1 {-|
    2 Module:      Y2015.D14
    3 Description: Advent of Code Day 14 Solutions.
    4 License:     MIT
    5 Maintainer:  @tylerjl
    6 
    7 Solutions to the day 14 set of problems for <adventofcode.com>.
    8 -}
    9 
   10 module Y2015.D14 (distanceRace, leadingRace) where
   11 
   12 import Data.List (foldl', maximumBy)
   13 
   14 data Reindeer = Reindeer
   15               { name      :: String
   16               , velocity  :: Int
   17               , endurance :: Int
   18               , cooldown  :: Int
   19               } deriving (Show, Eq)
   20 data Racer    = Racer
   21               { deer     :: Reindeer
   22               , score    :: Int
   23               , position :: Int
   24               } deriving (Show, Eq)
   25 data Race     = Race [Racer] Int
   26               deriving (Show)
   27 
   28 instance Ord Racer where
   29     Racer { score = a } `compare` Racer { score = b } = a `compare` b
   30 
   31 -- |Finds the winning deer in a distance race
   32 distanceRace :: String -- ^ Deer stats as raw string input
   33              -> Int    -- ^ Distance to run race
   34              -> Int    -- ^ Dat winning deer doe
   35 distanceRace d t = maximum $ map (flyFor t) $ toDeer d
   36 
   37 -- |Finds the winning deer in a race by most time spent in the lead
   38 leadingRace :: String -- ^ Deer stats as raw string input
   39             -> Int    -- ^ Distance to run race
   40             -> Int    -- ^ Dat winning deer doe
   41 leadingRace d t = score $ getWinner $ foldl' raceStep race [0..t]
   42     where race = Race (map toRacer $ toDeer d) 0
   43           getWinner (Race racers _) = maximum racers
   44 
   45 raceStep :: Race -> Int -> Race
   46 raceStep (Race racers time) tick = distPoints $ Race (map step racers) (time+1)
   47     where step r@Racer { deer = d, position = pos }
   48               | isResting d tick = r
   49               | otherwise        = r { position = pos + velocity d }
   50           distPoints (Race rs n) = Race (map (award $ position $ maximumBy leader rs) rs) n
   51           award pos r@Racer { position = p, score = s }
   52               | pos == p  = r { score = s + 1 }
   53               | otherwise = r
   54 
   55 leader :: Racer -> Racer -> Ordering
   56 leader Racer { position = a } Racer { position = b } =
   57     a `compare` b
   58 
   59 isResting :: Reindeer -> Int -> Bool
   60 isResting d t = t `mod` (endurance d + cooldown d) >= endurance d
   61 
   62 toRacer :: Reindeer -> Racer
   63 toRacer d = Racer { deer = d, score = 0, position = 0 }
   64 
   65 flyFor :: Int -> Reindeer -> Int
   66 flyFor t d = v * e * spans + v * minimum [stretch, e]
   67     where [v,e,c]  = [velocity d, endurance d, cooldown d]
   68           deerTime = e + c
   69           stretch  = t `mod` deerTime
   70           spans    = t `quot` deerTime
   71 
   72 toDeer :: String -> [Reindeer]
   73 toDeer = map (parseDeer . words . init) . lines
   74     where parseDeer [n,_,_,v,_,_,e,_,_,_,_,_,_,cd,_] =
   75               Reindeer { name      = n
   76                        , velocity  = read v
   77                        , endurance = read e
   78                        , cooldown  = read cd
   79                        }
   80           parseDeer _ =
   81               Reindeer { name      = "Null"
   82                        , velocity  = 0
   83                        , endurance = 0
   84                        , cooldown  = 0
   85                        }