Model simulating movements of cars in a Car Park
The simulation is about the cars entering a public car park area over
a period of 12 hours.
We use the Poisson distribution to simulate the number
of cars entering during each 30 minutes period.
Next, for each car that enters, we simulate the period it stays in the
parking by using the Geometric distribution.
library(tidyverse)
1 - Create the DataFrame
# create the DataFrame structure
# we track the cars entering over each 30 min period, from 8:00 am to 8:00 pm
# date_obs <- as.Date("2023-12-10")
set.seed(25)
n_entering <- rpois(n = 24, lambda = 10)
cars_movements <- data.frame(ent_period = 0, id_car = 0, stay_period = 0)
# populate the DataFrame
for (ii in 1:24) {
cc <- n_entering[ii]
ent_cars <- expand_grid(ent_period = ii, id_car = 1:cc)
ent_cars$id_car <- ent_cars$id_car + 100 * ii
ent_cars$stay_period = rgeom(n = cc, prob = 0.25)
cars_movements <- bind_rows(cars_movements, ent_cars)
}
# define the exit period as ent_period + stay_period
cars_movements <- cars_movements %>%
mutate(ext_period = ent_period + stay_period)
head(cars_movements, 12)
# define the starting time (the time when the car park opens)
start_time <- as.POSIXct("08:00", format = "%H:%M")
# convert the period number to time (N.B.: there are 1800 seconds in a period of 30 minutes)
cars_movements <- cars_movements %>%
mutate(ent_period_t = start_time + ent_period * 1800, ext_period_t = start_time + ext_period * 1800) %>%
filter(id_car != 0)
head(cars_movements, 12)
# range of entering and exiting periods
range(cars_movements$ent_period_t)
[1] "2024-04-07 08:30:00 CEST" "2024-04-07 20:00:00 CEST"
range(cars_movements$ext_period_t)
[1] "2024-04-07 09:00:00 CEST" "2024-04-08 04:30:00 CEST"
2 - Line Plot of cars entering and exiting over time
# set plotting area width in inches
#options(repr.plot.width = 12)
# define the graphic object ent_plot
ent_plot <- cars_movements %>% group_by(ent_period_t) %>%
summarize(num_cars = n()) %>%
ggplot(aes(x = ent_period_t, y = num_cars)) + geom_line(linewidth = 2, color = "forestgreen")
# define the ext_data
ext_data <- cars_movements %>% group_by(ext_period_t) %>%
summarize(num_cars = n())
# plot the cars entering and exiting
ent_plot +
geom_line(data = ext_data, aes(x = ext_period_t, y = num_cars), linewidth = 2, color = "red") +
scale_x_datetime(limits = c(min(cars_movements$ent_period_t), max(cars_movements$ent_period_t)),
date_labels = "%H:%M", date_breaks = "1 hour")

# plot the cars entering and exiting (the latter with negative sign)
ent_plot +
geom_line(data = ext_data, aes(x = ext_period_t, y = -num_cars), linewidth = 2, color = "red") +
scale_x_datetime(limits = c(min(cars_movements$ent_period_t), max(cars_movements$ent_period_t)),
date_labels = "%H:%M", date_breaks = "1 hour") + geom_hline(aes(yintercept = 0))

LS0tDQp0aXRsZTogIkNhciBQYXJrIFNpbXVsYXRpb24iDQphdXRob3I6ICJHaW92YW5uaSBWYWxlbnRpbmkiDQpvdXRwdXQ6IGh0bWxfbm90ZWJvb2sNCi0tLQ0KICANCiAgDQojIyBNb2RlbCBzaW11bGF0aW5nIG1vdmVtZW50cyBvZiBjYXJzIGluIGEgQ2FyIFBhcmsgIA0KICANClRoZSBzaW11bGF0aW9uIGlzIGFib3V0IHRoZSBjYXJzIGVudGVyaW5nIGEgcHVibGljIGNhciBwYXJrIGFyZWEgb3ZlciBhIHBlcmlvZCBvZiAxMiBob3Vycy4gIA0KV2UgdXNlIHRoZSAqKlBvaXNzb24gZGlzdHJpYnV0aW9uKiogdG8gc2ltdWxhdGUgdGhlIG51bWJlciBvZiBjYXJzIGVudGVyaW5nIGR1cmluZyBlYWNoIDMwIG1pbnV0ZXMgcGVyaW9kLiAgDQpOZXh0LCBmb3IgZWFjaCBjYXIgdGhhdCBlbnRlcnMsIHdlIHNpbXVsYXRlIHRoZSBwZXJpb2QgaXQgc3RheXMgaW4gdGhlIHBhcmtpbmcgYnkgdXNpbmcgdGhlICoqR2VvbWV0cmljIGRpc3RyaWJ1dGlvbioqLiAgDQogIA0KYGBge3J9DQpsaWJyYXJ5KHRpZHl2ZXJzZSkNCmBgYA0KIyMgMSAtIENyZWF0ZSB0aGUgRGF0YUZyYW1lICANCiAgDQpgYGB7cn0NCiMgY3JlYXRlIHRoZSBEYXRhRnJhbWUgc3RydWN0dXJlDQojIHdlIHRyYWNrIHRoZSBjYXJzIGVudGVyaW5nIG92ZXIgZWFjaCAzMCBtaW4gcGVyaW9kLCBmcm9tIDg6MDAgYW0gdG8gODowMCBwbQ0KIyBkYXRlX29icyA8LSBhcy5EYXRlKCIyMDIzLTEyLTEwIikNCnNldC5zZWVkKDI1KQ0Kbl9lbnRlcmluZyA8LSBycG9pcyhuID0gMjQsIGxhbWJkYSA9IDEwKQ0KY2Fyc19tb3ZlbWVudHMgPC0gZGF0YS5mcmFtZShlbnRfcGVyaW9kID0gMCwgaWRfY2FyID0gMCwgc3RheV9wZXJpb2QgPSAwKQ0KYGBgDQoNCmBgYHtyfQ0KIyBwb3B1bGF0ZSB0aGUgRGF0YUZyYW1lDQpmb3IgKGlpIGluIDE6MjQpIHsNCgljYyA8LSBuX2VudGVyaW5nW2lpXQ0KCWVudF9jYXJzIDwtIGV4cGFuZF9ncmlkKGVudF9wZXJpb2QgPSBpaSwgaWRfY2FyID0gMTpjYykNCgllbnRfY2FycyRpZF9jYXIgPC0gZW50X2NhcnMkaWRfY2FyICsgMTAwICogaWkNCgllbnRfY2FycyRzdGF5X3BlcmlvZCA9IHJnZW9tKG4gPSBjYywgcHJvYiA9IDAuMjUpDQoJY2Fyc19tb3ZlbWVudHMgPC0gYmluZF9yb3dzKGNhcnNfbW92ZW1lbnRzLCBlbnRfY2FycykNCn0NCmBgYA0KDQpgYGB7cn0NCiMgZGVmaW5lIHRoZSBleGl0IHBlcmlvZCBhcyBlbnRfcGVyaW9kICsgc3RheV9wZXJpb2QNCmNhcnNfbW92ZW1lbnRzIDwtIGNhcnNfbW92ZW1lbnRzICU+JSANCgltdXRhdGUoZXh0X3BlcmlvZCA9IGVudF9wZXJpb2QgKyBzdGF5X3BlcmlvZCkNCmhlYWQoY2Fyc19tb3ZlbWVudHMsIDEyKQ0KYGBgDQoNCmBgYHtyfQ0KIyBkZWZpbmUgdGhlIHN0YXJ0aW5nIHRpbWUgKHRoZSB0aW1lIHdoZW4gdGhlIGNhciBwYXJrIG9wZW5zKQ0Kc3RhcnRfdGltZSA8LSBhcy5QT1NJWGN0KCIwODowMCIsIGZvcm1hdCA9ICIlSDolTSIpDQojIGNvbnZlcnQgdGhlIHBlcmlvZCBudW1iZXIgdG8gdGltZSAoTi5CLjogdGhlcmUgYXJlIDE4MDAgc2Vjb25kcyBpbiBhIHBlcmlvZCBvZiAzMCBtaW51dGVzKQ0KY2Fyc19tb3ZlbWVudHMgPC0gY2Fyc19tb3ZlbWVudHMgJT4lIA0KCW11dGF0ZShlbnRfcGVyaW9kX3QgPSBzdGFydF90aW1lICsgZW50X3BlcmlvZCAqIDE4MDAsIGV4dF9wZXJpb2RfdCA9IHN0YXJ0X3RpbWUgKyBleHRfcGVyaW9kICogMTgwMCkgJT4lIA0KCWZpbHRlcihpZF9jYXIgIT0gMCkNCg0KaGVhZChjYXJzX21vdmVtZW50cywgMTIpDQpgYGANCiAgDQpgYGB7cn0NCiMgcmFuZ2Ugb2YgZW50ZXJpbmcgYW5kIGV4aXRpbmcgcGVyaW9kcw0KcmFuZ2UoY2Fyc19tb3ZlbWVudHMkZW50X3BlcmlvZF90KQ0KcmFuZ2UoY2Fyc19tb3ZlbWVudHMkZXh0X3BlcmlvZF90KQ0KYGBgDQogIA0KIyMgMiAtIExpbmUgUGxvdCBvZiBjYXJzIGVudGVyaW5nIGFuZCBleGl0aW5nIG92ZXIgdGltZSAgDQogIA0KYGBge3J9DQojIHNldCBwbG90dGluZyBhcmVhIHdpZHRoIGluIGluY2hlcyANCiNvcHRpb25zKHJlcHIucGxvdC53aWR0aCA9IDEyKQ0KYGBgDQogIA0KYGBge3J9DQojIGRlZmluZSB0aGUgZ3JhcGhpYyBvYmplY3QgZW50X3Bsb3QNCmVudF9wbG90IDwtIGNhcnNfbW92ZW1lbnRzICU+JSBncm91cF9ieShlbnRfcGVyaW9kX3QpICU+JSANCiAgc3VtbWFyaXplKG51bV9jYXJzID0gbigpKSAlPiUgDQogIGdncGxvdChhZXMoeCA9IGVudF9wZXJpb2RfdCwgeSA9IG51bV9jYXJzKSkgKyBnZW9tX2xpbmUobGluZXdpZHRoID0gMiwgY29sb3IgPSAiZm9yZXN0Z3JlZW4iKQ0KIyBkZWZpbmUgdGhlIGV4dF9kYXRhDQpleHRfZGF0YSA8LSBjYXJzX21vdmVtZW50cyAlPiUgZ3JvdXBfYnkoZXh0X3BlcmlvZF90KSAlPiUgDQogIHN1bW1hcml6ZShudW1fY2FycyA9IG4oKSkgDQojIHBsb3QgdGhlIGNhcnMgZW50ZXJpbmcgYW5kIGV4aXRpbmcgDQplbnRfcGxvdCArIA0KICBnZW9tX2xpbmUoZGF0YSA9IGV4dF9kYXRhLCBhZXMoeCA9IGV4dF9wZXJpb2RfdCwgeSA9IG51bV9jYXJzKSwgbGluZXdpZHRoID0gMiwgY29sb3IgPSAicmVkIikgKyANCglzY2FsZV94X2RhdGV0aW1lKGxpbWl0cyA9IGMobWluKGNhcnNfbW92ZW1lbnRzJGVudF9wZXJpb2RfdCksIG1heChjYXJzX21vdmVtZW50cyRlbnRfcGVyaW9kX3QpKSwgDQoJCQkJCSBkYXRlX2xhYmVscyA9ICIlSDolTSIsIGRhdGVfYnJlYWtzID0gIjEgaG91ciIpDQpgYGANCg0KYGBge3J9DQojIHBsb3QgdGhlIGNhcnMgZW50ZXJpbmcgYW5kIGV4aXRpbmcgKHRoZSBsYXR0ZXIgd2l0aCBuZWdhdGl2ZSBzaWduKSANCmVudF9wbG90ICsgDQogIGdlb21fbGluZShkYXRhID0gZXh0X2RhdGEsIGFlcyh4ID0gZXh0X3BlcmlvZF90LCB5ID0gLW51bV9jYXJzKSwgbGluZXdpZHRoID0gMiwgY29sb3IgPSAicmVkIikgKyANCglzY2FsZV94X2RhdGV0aW1lKGxpbWl0cyA9IGMobWluKGNhcnNfbW92ZW1lbnRzJGVudF9wZXJpb2RfdCksIG1heChjYXJzX21vdmVtZW50cyRlbnRfcGVyaW9kX3QpKSwgDQoJCQkJCSBkYXRlX2xhYmVscyA9ICIlSDolTSIsIGRhdGVfYnJlYWtzID0gIjEgaG91ciIpICsgZ2VvbV9obGluZShhZXMoeWludGVyY2VwdCA9IDApKQ0KYGBgDQogIA0KICA=