public
Last active

Theme Park (Optimized)

  • Download Gist
gistfile1.hs
Haskell
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149
-- This program solves the Theme Park Google CodeJam problem at
-- http://code.google.com/codejam/contest/dashboard?c=433101#s=p2
--
-- I've tried to make the code clear whilst employing a selection of Haskell library
-- functions and idioms. I've also gone for efficiency, probably over optimizing in
-- places in order to demonstrate some techniques.
 
module Main where
 
import Data.List
import Data.Array
import Text.Printf
 
-- The bigest number we need to handle is 10^8 * 10^9 which won't fit in 32 bits,
-- but will in 64. We could use Word64, but Integer will work just fine.
 
type N = Integer
 
 
-- Calculate the profit for a scenario.
--
-- To perform acceptably, we need to detect cycles in the list ride loading.
 
profit :: N -> N -> [N] -> N
profit cap rides groups
| sum groups <= cap = rides * sum groups
| otherwise = initialProfit + cycleProfit + finalProfit
where
initialProfit = rideProfit cycleStart
cycleProfit = (rideProfit cycleEnd - rideProfit cycleStart) * numCycles
numCycles = (rides - rideCount cycleStart) `div` cycleLength
finalProfit = rideProfit finalRide - rideProfit cycleEnd
(cycleStart, cycleEnd) = findCycle $ calcRides cap rides groups
finalRide = genericDrop numRidesAfterCycle cycleEnd
numRidesAfterCycle = rides - cycleLength * numCycles - rideCount cycleStart
cycleLength = rideCount cycleEnd - rideCount cycleStart
 
 
-- A Ride holds the state after each ride.
-- All members are strict so that accumulators accumulate rather than creating thunk chains.
 
data Ride = Ride
{ rCount :: !N -- The number of rides to this point
, rProfit :: !N -- The profit so far
, rNextIndex :: !Int -- The position in the original queue of the next group to board
}
deriving (Show)
 
 
-- A Loading represents a loading of the rollercoaster.
 
data Loading = Loading
{ lProfit :: !N -- The profit for this loading
, lNextIndex :: !Int -- The position in the original queue of the next group to board
}
 
 
-- Generate a list of rides for a scenario
 
calcRides :: N -> N -> [N] -> [Ride]
calcRides cap rides groups = iterate nextRide (Ride 0 0 0)
where
nextRide (Ride c p i) = let (Loading p' i') = loadings ! i in Ride (c + 1) (p + p') i'
loadings = calcLoadings cap groups
 
 
-- Generate an array of loadings from each possible starting position in the queue.
--
-- This is a memoization of the load function below. As we are interested in indeces later,
-- we convert the list of groups into an array and just track indices. Whilst we could call
-- load with an empty rollercoaster at each queue position, we optimize by loading the
-- coasater once then iteratively removing one group and filling just the empty seats.
-- The state for our unfold is the previous Loading and the list of groups to unload on each
-- future iteration.
 
calcLoadings :: N -> [N] -> Array Int Loading
calcLoadings cap groups = listArray (0, length groups - 1) . unfoldr nextLoading $ (Loading 0 0, 0 : groups)
where
nextLoading ((Loading p i), g:gs) =
let l = load cap groupsArray (Loading (p - g) i) in Just (l, (l, gs))
groupsArray = listArray (0, length groups - 1) groups
 
 
-- Complete the loading of a (possibly) partially loaded coaster.
 
load :: N -> Array Int N -> Loading -> Loading
load cap groups = until full nextGroup
where
full (Loading p i) = p + groups ! i > cap
nextGroup (Loading p i) = Loading (p + groups ! i) ((i + 1) `mod` numGroups)
numGroups = snd (bounds groups) + 1
 
 
-- Some utility functions for accessing information about the next ride in a list of rides.
 
rideCount :: [Ride] -> N
rideCount = rCount . head
 
rideProfit :: [Ride] -> N
rideProfit = rProfit . head
 
rideNextIndex :: [Ride] -> Int
rideNextIndex = rNextIndex . head
 
 
-- Find a cycle in the rides list.
--
-- We use a cut down version of Floyd's cycle-finding algorithm:
-- http://en.wikipedia.org/wiki/Cycle_detection. We don't need to find the smallest cycle,
-- just a cycle, so as soon as the tortoise and the hare are at the same index value, the
-- position of the tortoise is at the start of a cycle and the difference in position of
-- the hare and the tortoise is the length of the cycle.
 
findCycle :: [Ride] -> ([Ride], [Ride])
findCycle rides = until sameIndex move (rides, tail rides)
where
sameIndex (tortoise, hare) = rideNextIndex tortoise == rideNextIndex hare
move (tortoise, hare) = (tail tortoise, tail . tail $ hare)
 
 
-- Parse the input, process each test case and generate the output.
processFile :: String -> String
processFile s = unlines $ zipWith (printf "Case #%d: %d") ([1..]::[Int]) profits
where
cs = map (map read . words) . drop 1 . lines $ s
profits = chop processCase cs
 
 
-- Process an individual test case.
 
processCase :: [[N]] -> (N, [[N]])
processCase ( [rides, cap, _ ] : groups : rest) =
(profit cap rides groups, rest)
processCase _ = error "Invalid Format!!!!!"
 
 
-- Lennart's chop function
 
chop :: ([a] -> (b , [a])) -> [a] -> [b]
chop _ [] = []
chop f xs = y : chop f xs'
where (y, xs') = f xs
 
 
-- Main just calls processFile with standard in and directs the output to standard out.
 
main :: IO ()
main = interact processFile

Please sign in to comment on this gist.

Something went wrong with that request. Please try again.