Difference between revisions of "Composite traffic model"

# 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],]
		#trips.left$Secondary <- 0 # the "Secondary" row gives the number of trips which started elsewhere, i.e. they transfer here
	} else {
		trips.left <- trips.sample[trips.sample$Time <= times[i] & trips.sample$Time > times[i] - t.interval,]
		#trips.left <- merge(trips.left, trips.sample[trips.sample$Time <= times[i] & trips.sample$Time > times[i] - t.interval,])
	}
	
	# Optimizer main code
	
	d8 <- (trips.left$Result + trips.left$Secondary) %/% 8 * 8
	trips.left$Secondary <- trips.left$Secondary - d8
	trips.left$Result <- trips.left$Result + trips.left$Secondary - (trips.left$Result + trips.left$Secondary + d8) %% 8
	
	d4 <- (trips.left$Result + trips.left$Secondary) %/% 4 * 4
	trips.left$Secondary <- trips.left$Secondary - d4
	trips.left$Result <- trips.left$Result + trips.left$Secondary - (trips.left$Result + trips.left$Secondary + d4) %% 4
	
	# Now, if there are still some passengers left who have already transferred, make direct trips for them and possible remaining new passengers
	
	d3 <- ifelse(trips.left$Secondary > 0, (trips.left$Result + trips.left$Secondary) %/% 3 * 3, 0) 
	trips.left$Result <- trips.left$Result - d3
	trips.left$Secondary <- trips.left$Secondary + trips.left$Result - ifelse(trips.left$Secondary > 0, (trips.left$Result + 
		trips.left$Secondary + d3) %% 3, 0)
	
	d2 <- ifelse(trips.left$Secondary > 0, (trips.left$Result + trips.left$Secondary) %/% 2 * 2, 0) 
	trips.left$Result <- trips.left$Result - d2
	trips.left$Secondary <- trips.left$Secondary + trips.left$Result - ifelse(trips.left$Secondary > 0,(trips.left$Result + 
		trips.left$Secondary + d3) %% 2, 0)
	
	d1 <- ifelse(trips.left$Secondary > 0, trips.left$Secondary, 0) 
	trips.left$Secondary <- trips.left$Secondary - d1
	
	# Then for remaining new passengers, find a transfer point and 
	
	if (sum(trips.left$Result) > 0) {
		busiest <- tapply(trips$Result[trips$Time == times[i+1]], trips$From[trips$Time == times[i+1]], sum)
		busiest <- sort(busiest, decreasing = TRUE)
		
		trips.next <- merge(trips.left[trips.left$Result>0, c("From","To")], roads)
		#colnames(trips.next)[colnames(trips.next) == "From"] <- "Origin"
		#colnames(trips.next)[colnames(trips.next) == "Through"] <- "From"
		#colnames(trips.next)[colnames(trips.next) == "To"] <- "Destination"
		
		trips.next$Through <- match(trips.next$Through, names(busiest))
		chekpoints <- 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)
		
		# delay <- distance / speed
		
		ifelse(is.na(trips.left$Checkpoint) & trips.left$Result + trips.left$Secondary > 0
		
		trips.left <- 
		
		# Now divide and send, and add secondary passengers to later time points etc.
	}
	
	trips.out <- rbind(trips.out, data.frame(trips.left[, c("From", "To", "Time")], d8, d4, d3, d2, d1))
}