simulate

#!/usr/bin/env perl
use strict;
use warnings;
use 5.010;

use Data::Dumper;
use RVP::Time;
use List::Util qw(min first);
use List::MoreUtils qw(firstidx after indexes);

binmode(STDOUT, ":utf8");

my $d = do("route_data") or die($@);
my @physroutes = @{$d->{physroutes}};
my @routegens = @{$d->{routegens}};
my $starttime = isotr_2ts("2010-03-22 13:02:00", "context");

my %options = (
	route_min_count => 5,          # minimal amount of on-demand routes generated.
	route_max_count => 30,         # maximal amount of on-demand routes
	route_min_timespan => 30*60,   # routes for at least the next N seconds
	route_max_timespan => 2*60*60, # routes for at most the next N seconds

	route_max_wait_time => 4*60*60,# don't wait longer than this for the next train
	route_max_wait_skip => 10,     # ignore at most that many departing trains for a given segment
	                               # (might ignore more trains, if there are multiple equivalent trains with the exact same departure time.)
);

# tell if two routes are equal.
# they are not necessarily referentially equal, since they might have been
# produced by two different generator runs.
# the perfect solution would be to do a deep comparison.
# for now, comparing the name and the first station should be fine as well.
sub routes_equal {
	my ($ra, $rb) = @_;
	return 0 if (!defined($ra) or !defined($rb)); # don't spam if one doesn't exist.
	    $ra->{line}                      eq $rb->{line}
	and $ra->{route}->[0]->{stop}        eq $rb->{route}->[0]->{stop}
	and $ra->{route}->[0]->{depart}      == $rb->{route}->[0]->{depart};
}

# generate routes from {from} to {to} departing after or at {time}.
sub routegen_4segment {
	my %args = @_;

	# select routegens to be considered,
	# based on the physroute they will provide
	my @possible_routegens = grep {
		my $rg = $_;
		my $i_from = firstidx { $_->{station} eq $args{from} } @{$rg->{stations}};
		$i_from != -1
		and $i_from != @{$rg->{stations}} - 1
		and $rg->{stations}->[$i_from + 1]->{station} eq $args{to};
	} @routegens;

	# check
	if (!@possible_routegens) {
		die("There is no route generator for $args{from} -> $args{to} - this shouldn't be happening. Dying");
	}

	# go ask the routegen for some routes
	my @results;
	my $time = $args{time};
	while (  @results < $options{route_min_count} and $time < $args{time} + $options{route_min_timespan}
	and not (@results > $options{route_max_count} or  $time > $args{time} + $options{route_max_timespan})) {
		# ask the routegens to produce one route.
		my @nr = map { $_->{generator}->(
			template => $_,
			time => $time - (first { $_->{station} eq $args{from} } @{$_->{stations}})->{offset_depart}
		) } @possible_routegens;

		# no routes at all?
		# XXX is @nr populated with nothing or with undef in that case?
		if (!@nr) {
			die("Transportation services shut down all services in fear of the end of the world.");
		}

		# map routes to departure time at current station.
		my @r2d = map {
			my $route = $_;
			my $route_pos = firstidx { $_->{stop} eq $args{from} } @{$route->{route}};
			{
				route => $route, route_pos => $route_pos,
				arrive => $route->{route}->[$route_pos]->{arrive},
				depart => $route->{route}->[$route_pos]->{depart},
			}
		} @nr;

		# pick all with the minimal time.
		my $mintime = min map { $_->{depart} } @r2d;

		# sanity check
		if ($mintime < $time) {
			die("minimal departure time $mintime is before current time $time. The route data is crap.");
		}

		# use all routes with that depart time.
		push(@results, grep { $_->{depart} == $mintime } @r2d);

		# adjust next time
		$time = $mintime + 1;
	}

	@results;
}

sub sim_timestep {
	my ($trip, $nsc, $physroute, $completed_trips) = @_;

	# print STDERR "evaluating trip " . trip_details($trip) . "\n";

	# XXX oh let's insert some sanity checks here.
	if (!defined($trip->{state}->{next_time})) {
		die("Trip " . trip_details($trip) . " -- has NO CURRENT TIME!");
	}
	if (!defined($trip->{state}->{station})) {
		die("Trip " . trip_details($trip) . " -- has NO CURRENT STATION!");
	}
	if (!($trip->{state}->{station} ~~ $physroute)) {
		die("Trip " . trip_details($trip) . " -- ended up off-route");
	}

	if ($trip->{state}->{state} eq "wait_arrive_station") {
		my $next_stop = (after { $_ eq $trip->{state}->{station} } @{$physroute})[0];
		# print STDERR "what to do now at $trip->{state}->{station}...\n";

		# ask for some routes for this segment
		my @routes = routegen_4segment(from => $trip->{state}->{station}, to => $next_stop, time => $nsc);

		# too much time? kill ourselves.
		if ($trip->{events}->[-1]->{time} + $options{route_max_wait_time} < $nsc) {
			return ();
		}

		# let's generate additional trips for the two possibilities.
		# note that the trip data is NOT deep cloned. this is intentional.
		my @rt;

		# if there are other trains that have not arrived yet, add trips that wait for them.
		my $min_nsc = min map { $_->{arrive} } grep { $_->{arrive} > $nsc } @routes;
		if (defined($min_nsc) and (!defined($trip->{state}->{wait_skipped}) or $trip->{state}->{wait_skipped} <= $options{route_max_wait_skip})) {
			push(@rt, {
				events => [ @{$trip->{events}} ],
				state => {
					station   => $trip->{state}->{station},
					next_time => $min_nsc,
					wait_skipped => ($trip->{state}->{wait_skipped} // 0) + 1,
					route     => undef,
					prev_route=> $trip->{state}->{prev_route},
					state     => "wait_arrive_station",
				},
			});
		}

		# add trips for all trains that have already arrived.
		POSS_ROUTE: foreach my $pr (grep { $_->{arrive} <= $nsc and !routes_equal($_->{route}, $trip->{state}->{prev_route}) } @routes) {
			# rule out some choices that are deemed to be "unattractive".

			# for example, forbid entering a line that provides a connection to the next station,
			# that isn't better than the one the previous route could provide.
			if (defined($trip->{state}->{prev_route})) {
				my $i_old = firstidx { $_->{stop} eq $trip->{state}->{station} } @{$trip->{state}->{prev_route}->{route}};
				my $i_new = firstidx { $_->{stop} eq $trip->{state}->{station} } @{$pr->{route}->{route}};

				if ($i_old == -1 or $i_new == -1) {
					die("Sanity check failed: the old or the new route don't contain the current station");
				}

				if ($trip->{state}->{prev_route}->{route}->[$i_old + 1]->{stop} eq $pr->{route}->{route}->[$i_new + 1]->{stop}) {
					my $t_old = $trip->{state}->{prev_route}->{route}->[$i_old + 1]->{depart}
					          - $trip->{state}->{prev_route}->{route}->[$i_old    ]->{depart};
					my $t_new = $pr->{route}->{route}->[$i_new + 1]->{depart}
					          - $pr->{route}->{route}->[$i_new    ]->{depart};

					if ($t_new >= $t_old) {
						next;
					}
				}
			}

			push(@rt, {
				events => [ @{$trip->{events}}, {
					time       => $pr->{depart},
					enter_time => $nsc,
					event      => "depart",
					station    => $trip->{state}->{station},
					route      => $pr->{route},
				} ],
				state => {
					station   => $trip->{state}->{station},
					next_time => $pr->{route}->{route}->[$pr->{route_pos} + 1]->{arrive},
					route     => $pr->{route},
					route_pos => $pr->{route_pos},
					state     => "wait_arrive_train",
				},
			});
		}

		return @rt;
	} elsif ($trip->{state}->{state} eq "wait_arrive_train") {
		# we arrived! generate trips for exiting trains and/or staying on train.
		my @rt;

		# first add the arrive event to the event list and update state first.
		$trip->{state}->{route_pos}++;
		$trip->{state}->{station} = $trip->{state}->{route}->{route}->[$trip->{state}->{route_pos}]->{stop};

		# if we arrived at the final stop, get off here and exit!
		if ($trip->{state}->{station} eq $physroute->[-1]) {
			push(@{$trip->{events}}, {
				time     => $nsc,
				event    => "arrive",
				station  => $trip->{state}->{station},
				route    => $trip->{state}->{route},
			}, {
				time     => $nsc,
				event    => "vp_exit",
			});
			push(@{$completed_trips}, $trip);
			return ();
		}

		# add trip for waiting in train, if the next stop is the next on route
		if (defined($trip->{state}->{route}->{route}->[$trip->{state}->{route_pos} + 1])
		and $trip->{state}->{route}->{route}->[$trip->{state}->{route_pos} + 1]->{stop} ~~ $physroute) {
			push(@rt, {
				events => [ @{$trip->{events}} ],
				state => {
					station   => $trip->{state}->{station},
					next_time => $trip->{state}->{route}->{route}->[$trip->{state}->{route_pos} + 1]->{arrive},
					route     => $trip->{state}->{route},
					route_pos => $trip->{state}->{route_pos},
					state     => "wait_arrive_train",
				},
			});
		}

		# get off at this station
		push(@rt, {
			events => [ @{$trip->{events}}, {
				time     => $nsc,
				event    => "arrive",
				station  => $trip->{state}->{station},
				route    => $trip->{state}->{route},
			} ],
			state => {
				station   => $trip->{state}->{station},
				next_time => $nsc,
				route     => undef,
				route_pos => undef,
				prev_route=> $trip->{state}->{route},
				state     => "wait_arrive_station",
			},
		});

		return @rt;
	} else {
		die("Trip has entered invalid or unknown state $trip->{state}->{state}");
	}
}

sub trip_details {
	my ($trip) = @_;
	sprintf("((%s) %s %s %s): %s",
		ts_2datetime($trip->{state}->{next_time}, "context")->strftime("%H:%M"),
		$trip->{state}->{state},
		$trip->{state}->{station},
		$trip->{state}->{route} ? $trip->{state}->{route}->{line} : "-",
		join(" - ", map { sprintf("(%s) %s %s",
			ts_2datetime($_->{time}, "context")->strftime("%H:%M"),
			$_->{event},
			$_->{station}
		) } @{$trip->{events}}),
	);
}

foreach my $physroute (@physroutes) {
	print "\n" . "-" x 80 . "\n\n";
	print "next route: " . join(" - ", @{$physroute}) . "\n";

	# initialize the trips list with one trip, that starts with the
	# virtual passenger (VP) at the start station.

	my @trips = (
		{
			state => {
				station   => $physroute->[0],
				next_time => $starttime,
				route     => undef,
				state     => "wait_arrive_station",
			},
			events => [
				{
					event   => "vp_start",
					station => $physroute->[0],
					time    => $starttime,
				},
			],
		},
	);

	my @completed_trips;

	while (@trips) {
		# next simulation point-in-time: smallest NSC
		my $nsc = min map { $_->{state}->{next_time} } @trips;
		print STDERR "\n\nsimulation time: " . ts_2datetime($nsc, "context")->strftime("%H:%M (%Y-%m-%d %S)") . "\n";

		# process all trips with that NSC.
		@trips = ((grep { $_->{state}->{next_time} != $nsc } @trips), map { sim_timestep($_, $nsc, $physroute, \@completed_trips) } grep { $_->{state}->{next_time} == $nsc } @trips);
	}

	# print result trips
	foreach my $trip (@completed_trips) {
		for (my $si = 0; $si < @{$trip->{events}}; $si++) {
			if ($trip->{events}->[$si]->{event} eq "depart") {
				print "\n";
				printf("%5s %2s  %-30s  %s\n",
					ts_2datetime($trip->{events}->[$si]->{time}, "context")->strftime("%H:%M"),
					"ab",
					$trip->{events}->[$si]->{station},
					$trip->{events}->[$si]->{route}->{line},
				);
			} elsif ($trip->{events}->[$si]->{event} eq "arrive") {
				printf("%5s %2s  %-30s\n",
					ts_2datetime($trip->{events}->[$si]->{time}, "context")->strftime("%H:%M"),
					"an", $trip->{events}->[$si]->{station},
				);
			}
		}
		print "\n" . "-" x 6 . "\n";
	}
}