Composite traffic model

This page is a knowledge crystal of subtype method. The page identifier is Op_en5136
Moderator:Smxb (see all)
This page is a stub. You may improve it into a full page.
Upload data {{#opasnet_base_link:Op_en5136}}

This page is about a composite traffic model that is an updated version of File:Composite traffic.ANA. The new version is coded with R.

Definition

R model

• Trip aggregator
  • Optimization rules:

1. No second transfer -> prioritize "secondary" passengers
2. Fill as many 8-person-vehicles as possible
3. Fill as many 4-person-vehicles as possible
4. Special rule: for trips with no possible transfer-point -> direct trip
5. Transfer the rest (will always be 4-person-vehicles)
6. Re-check vehicle configurations, when exact numbers of primary and secondary passengers as well as transferees are known

+ Show code- Hide code # Trip aggregator, sampled passenger data as input times <- 0 from <- 1 trips.sample <- data.frame() trips.next <- data.frame() trips.left <- data.frame() trips.out <- data.frame() trips.secondary <- data.frame() t.interval <- 1 trips.sample$Secondary <- 0 for (i in 1:length(times)) { if(i == 1) { trips.left <- trips.sample[trips.sample$Time <= times[i],] } else { trips.left <- trips.sample[trips.sample$Time <= times[i] & trips.sample$Time > times[i] - t.interval,] } # Optimizer main code optimal.d.trips <- 0 sub.optimal.d.trips <- 0 optimal.d.trips <- (trips.left$Result + trips.left$Secondary) %/% 4 * 4 sub.optimal.d.trips <- ifelse(trips.left$Secondary - optimal.d.trips > 0, trips.left$Result + trips.left$Secondary - optimal.d.trips, 0) busiest <- tapply(trips$Result[trips$Time == times[i+1]], trips$From[trips$Time == times[i+1]], sum) busiest <- sort(busiest, decreasing = TRUE) condition <- trips.left$Result + trips.left$Secondary - optimal.d.trips - sub.optimal.d.trips > 0 trips.next <- merge(trips.left[condition, c("From","To")], roads) trips.next$Through <- match(trips.next$Through, names(busiest)) checkpoints <- tapply(trips.next$Through, trips.next[,c("From", "To")], min) colnames(trips.left)[colnames(trips.left) == "Freq"] <- "Checkpoint" trips.left <- merge(trips.left, as.data.frame(as.table(checkpoints)), all = TRUE) # Take into account those that don't have a checkpoint condition2 <- condition & is.na(trips.left$Checkpoint) no.transfer <- ifelse(condition2), (trips.left$Result + trips.left$Secondary - optimal.d.trips - sub.optimal.d.trips)[condition2], 0) trips.left$Optim.d.trips <- optimal.d.trips trips.left$Sub.optim.d.trips <- sub.optimal.d.trips trips.left$No.transfer <- no.transfer # Transfers trips.left.trans <- data.frame(trips.left[!condition2, c("From", "Checkpoint", "To", "Time")], Transferred = (trips.left$Result + trips.left$Secondary - optimal.d.trips - sub.optimal.d.trips)[!condition2]) colnames(trips.left.trans)[1] <- "From" colnames(trips.left.trans)[3] <- "Destination" colnames(trips.left.trans)[2] <- "To" trips.left <- merge(trips.left, trips.left.trans[,-c(3,4)], all = TRUE) trips.left$Transferred[is.na(trips.left$Transferred)] <- 0 # Now divide passengers to cars n.full.8.cars <- (trips.left$Optim.d.trip + trips.left$Sub.optim.d.trip + trips.left$No.transfer + trips.left$Transferred) %/% 8 n.full.4.cars <- (trips.left$Optim.d.trip + trips.left$Sub.optim.d.trip + trips.left$No.transfer + trips.left$Transferred - n.full.8.cars * 8) %/% 4 n.4.cars.3.pas <- (trips.left$Optim.d.trip + trips.left$Sub.optim.d.trip + trips.left$No.transfer + trips.left$Transferred - n.full.8.cars * 8 - n.full.4.cars * 4) %/% 3 n.4.cars.2.pas <- (trips.left$Optim.d.trip + trips.left$Sub.optim.d.trip + trips.left$No.transfer + trips.left$Transferred - n.full.8.cars * 8 - n.full.4.cars * 4 - n.4.cars.3.pas * 3) %/% 2 n.4.cars.1.pas <- trips.left$Optim.d.trip + trips.left$Sub.optim.d.trip + trips.left$No.transfer + trips.left$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.left$Optim.d.trip + trips.left$Sub.optim.d.trip + trips.left$No.transfer < 8 * n.full.8.cars, trips.left$Optim.d.trip + trips.left$Sub.optim.d.trip + trips.left$No.transfer, 8 * n.full.8.cars) d4 <- ifelse(trips.left$Optim.d.trip + trips.left$Sub.optim.d.trip + trips.left$No.transfer - d8 < 4 * n.full.4.cars, trips.left$Optim.d.trip + trips.left$Sub.optim.d.trip + trips.left$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.left$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.left$Transferred - c8 - c4) d2 <- 2 * n.4.cars.2.pas - c2 c1 <- n.4.cars.1.pas * (trips.left$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 <- 1 colnames(trips.left.trans)[5] <- "New.secondary" colnames(trips.left.trans)[1] <- "Origin" colnames(trips.left.trans)[2] <- "From" colnames(trips.left.trans)[3] <- "To" trips.left.trans$Time <- trips.left.trans$Time + delay trips.sample <- merge(trips.sample, trips.left.trans[,c(2,3,4,5)], all = TRUE) trips.sample$New.secondary[is.na(trips.sample$New.secondary)] <- 0 trips.sample$Secondary <- trips.sample$Secondary + trips.sample$New.secondary trips.sample <- trips.sample[,!colnames(trips.sample) %in% "New.secondary"] trips.out <- rbind(trips.out, data.frame(trips.left[, c("From", "To", "Time")], d8, d4, d3, d2, d1, c8, c4, c3, c2, c1)) }

TODO: {{#todo:Ruvetaan keräämään tälle sivulle matskua mallin uudesta versiosta.|Smxb|}}