+ Show code- Hide code
# Trip aggregator, sampled passenger data as input
n.intervals.per.h <- 5
trips.next <- data.frame()
trips.left <- data.frame()
trips.out <- data.frame()
trips.secondary <- data.frame()
times <- seq(1, 25, 1 / n.intervals.per.h)
library(OpasnetBaseUtils)
roads <- op_baseGetData("opasnet_base", "Op_en2634", apply.utf8 = FALSE)
colnames(roads)[6] <- "Through"
trips.locs <- op_baseGetLocs("opasnet_base", "Op_en2625", apply.utf8 = FALSE)
for (i in 1:(length(times) - 2)) {
if(i == 1) {
trips.sample.1 <- op_baseGetData("opasnet_base", "Op_en2625", include = trips.locs$loc_id[trips.locs$ind == "Time" &
trips.locs$loc == times[1]])
trips.sample.1$Secondary <- 0
} else {
trips.sample.1 <- trips.sample.2
trips.sample.1 <- merge(trips.sample.1, trips.secondary, all.x = TRUE)
trips.sample.1$Secondary[is.na(trips.sample.1$Secondary)] <- 0
}
trips.sample.2 <- op_baseGetData("opasnet_base", "Op_en2625", include = trips.locs$loc_id[trips.locs$ind == "Time" &
trips.locs$loc == times[i + 1]])
# Optimizer main code
optimal.d.trips <- 0
sub.optimal.d.trips <- 0
optimal.d.trips <- (trips.sample.1$Result + trips.sample.1$Secondary) %/% 4 * 4
sub.optimal.d.trips <- ifelse(trips.sample.1$Secondary - optimal.d.trips > 0, trips.sample.1$Result + trips.sample.1$Secondary - optimal.d.trips, 0)
busiest <- tapply(trips.sample.2$Result, trips.sample.2$From, sum)
busiest <- sort(busiest, decreasing = TRUE)
condition <- trips.sample.1$Result + trips.sample.1$Secondary - optimal.d.trips - sub.optimal.d.trips > 0
trips.next <- merge(trips.sample.1[condition, c("From","To")], roads[,c("From","To","Through")], all.x = TRUE)
trips.next$Through <- match(trips.next$Through, names(busiest))
checkpoints <- tapply(trips.next$Through, trips.next[,c("From", "To")], min)
trips.sample.1 <- merge(trips.sample.1, as.data.frame(as.table(checkpoints)), all.x = TRUE)
colnames(trips.sample.1)[colnames(trips.sample.1) == "Freq"] <- "Checkpoint"
trips.sample.1$Checkpoint <- names(busiest)[trips.sample.1$Checkpoint]
# Take into account those that don't have a checkpoint
condition2 <- is.na(trips.sample.1$Checkpoint)
condition3 <- trips.sample.1$Result + trips.sample.1$Secondary - optimal.d.trips - sub.optimal.d.trips > 0
no.transfer <- ifelse(condition2 & condition3, (trips.sample.1$Result + trips.sample.1$Secondary -
optimal.d.trips - sub.optimal.d.trips)[condition2 & condition3], 0)
trips.sample.1$Optim.d.trips <- optimal.d.trips
trips.sample.1$Sub.optim.d.trips <- sub.optimal.d.trips
trips.sample.1$No.transfer <- no.transfer
# Transfers
trips.left.trans <- data.frame(trips.sample.1[!condition2 & condition3, c("From", "Checkpoint", "To", "Time")],
Transferred = (trips.sample.1$Result + trips.sample.1$Secondary - optimal.d.trips - sub.optimal.d.trips)[!condition2 & condition3])
colnames(trips.left.trans)[1] <- "From"
colnames(trips.left.trans)[3] <- "Destination"
colnames(trips.left.trans)[2] <- "To"
trips.sample.1 <- merge(trips.sample.1, as.data.frame(as.table(tapply(trips.left.trans$Transferred, trips.left.trans[,c("From","To")], sum))),
all.x = TRUE)
colnames(trips.sample.1)[colnames(trips.sample.1) %in% "Freq"] <- "Transferred"
trips.sample.1$Transferred[is.na(trips.sample.1$Transferred)] <- 0
# Now divide passengers to cars
n.full.8.cars <- (trips.sample.1$Optim.d.trip + trips.sample.1$Sub.optim.d.trip + trips.sample.1$No.transfer + trips.sample.1$Transferred) %/% 8
n.full.4.cars <- (trips.sample.1$Optim.d.trip + trips.sample.1$Sub.optim.d.trip + trips.sample.1$No.transfer + trips.sample.1$Transferred -
n.full.8.cars * 8) %/% 4
n.4.cars.3.pas <- (trips.sample.1$Optim.d.trip + trips.sample.1$Sub.optim.d.trip + trips.sample.1$No.transfer + trips.sample.1$Transferred -
n.full.8.cars * 8 - n.full.4.cars * 4) %/% 3
n.4.cars.2.pas <- (trips.sample.1$Optim.d.trip + trips.sample.1$Sub.optim.d.trip + trips.sample.1$No.transfer + trips.sample.1$Transferred -
n.full.8.cars * 8 - n.full.4.cars * 4 - n.4.cars.3.pas * 3) %/% 2
n.4.cars.1.pas <- trips.sample.1$Optim.d.trip + trips.sample.1$Sub.optim.d.trip + trips.sample.1$No.transfer + trips.sample.1$Transferred -
n.full.8.cars * 8 - n.full.4.cars * 4 - n.4.cars.3.pas * 3 - n.4.cars.2.pas * 2
d8 <- ifelse(trips.sample.1$Optim.d.trip + trips.sample.1$Sub.optim.d.trip + trips.sample.1$No.transfer < 8 * n.full.8.cars,
trips.sample.1$Optim.d.trip + trips.sample.1$Sub.optim.d.trip + trips.sample.1$No.transfer, 8 * n.full.8.cars)
d4 <- ifelse(trips.sample.1$Optim.d.trip + trips.sample.1$Sub.optim.d.trip + trips.sample.1$No.transfer - d8 < 4 * n.full.4.cars,
trips.sample.1$Optim.d.trip + trips.sample.1$Sub.optim.d.trip + trips.sample.1$No.transfer - d8, 4 * n.full.4.cars)
c8 <- 8 * n.full.8.cars - d8
c4 <- 4 * n.full.4.cars - d4
c3 <- n.4.cars.3.pas * (trips.sample.1$Transferred - c8 - c4) # Note: there will be only 1 partially filled car
d3 <- 3 * n.4.cars.3.pas - c3
c2 <- n.4.cars.2.pas * (trips.sample.1$Transferred - c8 - c4)
d2 <- 2 * n.4.cars.2.pas - c2
c1 <- n.4.cars.1.pas * (trips.sample.1$Transferred - c8 - c4)
d1 <- n.4.cars.1.pas - c1
# Add transferred passengers to the next time slot as secondary passengers
# delay <- distance / speed
delay <- 0.2
colnames(trips.left.trans)[5] <- "Secondary"
colnames(trips.left.trans)[1] <- "Origin"
colnames(trips.left.trans)[2] <- "From"
colnames(trips.left.trans)[3] <- "To"
trips.left.trans$Time <- as.character(as.numeric(as.character(trips.left.trans$Time)) + delay)
trips.left.trans <- as.data.frame(as.table(tapply(trips.left.trans$Secondary, trips.left.trans[,
c("From","To","Time")], sum)))
colnames(trips.left.trans)[4] <- "Secondary"
trips.left.trans <- trips.left.trans[!is.na(trips.left.trans$Secondary),]
trips.secondary <- rbind(trips.secondary, trips.left.trans)
trips.out <- rbind(trips.out, data.frame(trips.sample.1[, c("From", "To", "Time")], d8, d4, d3, d2, d1, c8, c4, c3, c2, c1))
}
| |