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
| {-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE RecordWildCards #-}
import Prelude hiding (id)
import Data.List
import Data.Ord (comparing)
import Data.Function (on)
data Ride = Ride {
id :: Int,
start_x :: Int,
start_y :: Int,
end_x :: Int,
end_y :: Int,
start_t :: Int,
end_t :: Int
} deriving (Eq, Show)
instance Ord Ride where
(<=) = (<=) `on` (id :: Ride -> Int)
data Car = Car {
id :: Int,
x :: Int,
y :: Int,
time :: Int,
history :: [Ride]
} deriving (Show)
instance Eq Car where
(==) = (==) `on` (id :: Car -> Int)
type XY = (Int, Int)
distance :: XY -> XY -> Int
distance (start_x, start_y) (end_x, end_y) =
abs(start_x - end_x) + abs(start_y - end_y)
read_ints :: IO [Int]
read_ints = map read . words <$> getLine
write_ints :: [Int] -> IO ()
write_ints = putStrLn . (intercalate " ") . (map show)
assigned :: Car -> [Int]
assigned Car{history} =
(length history) : (reverse (map (id :: Ride -> Int) history))
solve :: [Int] -> [Ride] -> [Car]
solve [c_R, c_C, c_F, c_N, c_B, c_T] rides =
loop cars rides []
where
cars = [Car{id=i, x=0, y=0, time=0, history=[]} | i <- [0..c_F-1]]
loop :: [Car] -> [Ride] -> [Car] -> [Car]
loop [] _ retired = retired
loop cars [] retired = cars ++ retired
loop cars (r:rs) retired =
let
(benefit, c) =
maximumBy (comparing fst) $ map (\c -> (reward c r, c)) cars
(new_cars, to_retire) =
partition (\Car{time} -> time < c_T) $ update_cars c
in
case benefit <= 0 of
True -> loop cars rs retired
False -> loop new_cars rs (to_retire ++ retired)
where
update_cars target =
map (\c -> if c == target then update c r else c) cars
update :: Car -> Ride -> Car
update c@Car{x, y, time,history} r@Ride{..} =
let
new_x = end_x
new_y = end_y
actual_start_t = max start_t (time + togo)
new_time = actual_start_t + ride_len
in
c{x = new_x, y = new_y, time = new_time, history = (r:history)}
where
start_xy = (start_x, start_y)
end_xy = (end_x, end_y)
xy = (x, y)
togo = distance start_xy xy
ride_len = distance start_xy end_xy
reward :: Car -> Ride -> Float
reward c@Car{x, y, time} r@Ride{..} =
if deadline_missed
then 0
else fromIntegral (ride_len + bonus)
/ (fromIntegral (ride_len + bonus + penalty))
where
start_xy = (start_x, start_y)
end_xy = (end_x, end_y)
xy = (x, y)
togo = distance start_xy xy
ride_len = distance start_xy end_xy
bonus =
let
on_time = (start_t - time) >= togo
in
if on_time then c_B else 0
penalty = max (start_t - time) togo
deadline_missed = togo + time + ride_len >= end_t
solve _ _ = undefined
read_ride args n id rides
| n == id = mapM_ write_ints $ map assigned $ solve args $ reverse rides
| otherwise = do
[start_x, start_y, end_x, end_y, start_t, end_t] <- read_ints
read_ride args n (id+1) $ Ride{..}:rides
main = do
args <- read_ints
read_ride args (args !! 3) 0 []
|