From fa20c21ec26358cdba769f3b52e859ac685c2b0c Mon Sep 17 00:00:00 2001 From: Birte Kristina Friesel Date: Sun, 21 Jul 2024 19:22:52 +0200 Subject: Add lat/lon to pre-2.7.8 journeys; add eva where missing This speeds up the map significantly and makes coordinates_by_station obsolete --- lib/Travelynx.pm | 77 +++++++++--------- lib/Travelynx/Command/database.pm | 146 +++++++++++++++++++++++++++++++++- lib/Travelynx/Controller/Traveling.pm | 2 - lib/Travelynx/Model/Journeys.pm | 17 ++-- 4 files changed, 191 insertions(+), 51 deletions(-) (limited to 'lib') diff --git a/lib/Travelynx.pm b/lib/Travelynx.pm index 37afd9a..0c5a5ae 100755 --- a/lib/Travelynx.pm +++ b/lib/Travelynx.pm @@ -177,17 +177,6 @@ sub startup { } ); - $self->attr( - coordinates_by_station => sub { - my $legacy_names = $self->app->renamed_station; - my $location = $self->stations->get_latlon_by_name; - while ( my ( $old_name, $new_name ) = each %{$legacy_names} ) { - $location->{$old_name} = $location->{$new_name}; - } - return $location; - } - ); - # https://de.wikipedia.org/wiki/Liste_nach_Gemeinden_und_Regionen_benannter_IC/ICE-Fahrzeuge#Namensgebung_ICE-Triebz%C3%BCge_nach_Gemeinden # via https://github.com/marudor/bahn.expert/blob/main/src/server/coachSequence/TrainNames.ts $self->attr( @@ -297,13 +286,12 @@ sub startup { journeys => sub { my ($self) = @_; state $journeys = Travelynx::Model::Journeys->new( - log => $self->app->log, - pg => $self->pg, - in_transit => $self->in_transit, - stats_cache => $self->journey_stats_cache, - renamed_station => $self->app->renamed_station, - latlon_by_station => $self->app->coordinates_by_station, - stations => $self->stations, + log => $self->app->log, + pg => $self->pg, + in_transit => $self->in_transit, + stats_cache => $self->journey_stats_cache, + renamed_station => $self->app->renamed_station, + stations => $self->stations, ); } ); @@ -2041,8 +2029,6 @@ sub startup { my $route_type = $opt{route_type} // 'polybee'; my $include_manual = $opt{include_manual} ? 1 : 0; - my $location = $self->app->coordinates_by_station; - my $with_polyline = $route_type eq 'beeline' ? 0 : 1; if ( not @journeys ) { @@ -2058,12 +2044,19 @@ sub startup { my $first_departure = $journeys[-1]->{rt_departure}; my $last_departure = $journeys[0]->{rt_departure}; - my @stations = List::Util::uniq map { $_->{to_name} } @journeys; - push( @stations, - List::Util::uniq map { $_->{from_name} } @journeys ); - @stations = List::Util::uniq @stations; - my @station_coordinates = map { [ $location->{$_}, $_ ] } - grep { exists $location->{$_} } @stations; + my @stations = uniq_by { $_->{name} } map { + { + name => $_->{to_name}, + latlon => $_->{to_latlon} + }, + { + name => $_->{from_name}, + latlon => $_->{from_latlon} + } + } @journeys; + + my @station_coordinates + = map { [ $_->{latlon}, $_->{name} ] } @stations; my @station_pairs; my @polylines; @@ -2127,23 +2120,26 @@ sub startup { for my $journey (@beeline_journeys) { - my @route = map { $_->[0] } @{ $journey->{route} }; + my @route = @{ $journey->{route} }; my $from_index - = first_index { $_ eq $journey->{from_name} } @route; - my $to_index = first_index { $_ eq $journey->{to_name} } @route; + = first_index { $_->[0] eq $journey->{from_name} } @route; + my $to_index + = first_index { $_->[0] eq $journey->{to_name} } @route; if ( $from_index == -1 ) { my $rename = $self->app->renamed_station; $from_index = first_index { - ( $rename->{$_} // $_ ) eq $journey->{from_name} + ( $rename->{ $_->[0] } // $_->[0] ) eq + $journey->{from_name} } @route; } if ( $to_index == -1 ) { my $rename = $self->app->renamed_station; $to_index = first_index { - ( $rename->{$_} // $_ ) eq $journey->{to_name} + ( $rename->{ $_->[0] } // $_->[0] ) eq + $journey->{to_name} } @route; } @@ -2177,7 +2173,7 @@ sub startup { @route = @route[ $from_index .. $to_index ]; - my $key = join( '|', @route ); + my $key = join( '|', map { $_->[0] } @route ); if ( $seen{$key} ) { next; @@ -2186,7 +2182,7 @@ sub startup { $seen{$key} = 1; # direction does not matter at the moment - $seen{ join( '|', reverse @route ) } = 1; + $seen{ join( '|', reverse map { $_->[0] } @route ) } = 1; my $prev_station = shift @route; for my $station (@route) { @@ -2195,14 +2191,17 @@ sub startup { } } - @station_pairs = uniq_by { $_->[0] . '|' . $_->[1] } @station_pairs; - @station_pairs = grep { - exists $location->{ $_->[0] } - and exists $location->{ $_->[1] } - } @station_pairs; @station_pairs - = map { [ $location->{ $_->[0] }, $location->{ $_->[1] } ] } + = uniq_by { $_->[0][0] . '|' . $_->[1][0] } @station_pairs; + @station_pairs + = grep { defined $_->[0][2]{lat} and defined $_->[1][2]{lat} } @station_pairs; + @station_pairs = map { + [ + [ $_->[0][2]{lat}, $_->[0][2]{lon} ], + [ $_->[1][2]{lat}, $_->[1][2]{lon} ] + ] + } @station_pairs; my $ret = { skipped_journeys => \@skipped_journeys, diff --git a/lib/Travelynx/Command/database.pm b/lib/Travelynx/Command/database.pm index fb5ee80..ae17f64 100644 --- a/lib/Travelynx/Command/database.pm +++ b/lib/Travelynx/Command/database.pm @@ -1948,7 +1948,7 @@ my @migrations = ( }, # v51 -> v52 - # Explicitly encode backend type; preparation for multiple hAFAS backends + # Explicitly encode backend type; preparation for multiple HAFAS backends sub { my ($db) = @_; $db->query( @@ -2050,6 +2050,9 @@ my @migrations = ( } ); }, + + # v52 -> v53 + # Extend train_id to be compatible with more recent HAFAS versions sub { my ($db) = @_; $db->query( @@ -2166,6 +2169,147 @@ my @migrations = ( } ); }, + + # v53 -> v54 + # Retrofit lat/lon data onto routes logged before v2.7.8; ensure + # consistent name and eva entries as well. + sub { + my ($db) = @_; + + say +'Adding lat/lon to routes of journeys logged before v2.7.8 and improving consistency of name/eva data in very old route entries.'; + say 'This may take a while ...'; + + my %legacy_to_new; + if ( -r 'share/old_station_names.json' ) { + %legacy_to_new = %{ JSON->new->utf8->decode( + scalar read_file('share/old_station_names.json') + ) + }; + } + + my %latlon_by_eva; + my %latlon_by_name; + my $res = $db->select( 'stations', [ 'name', 'eva', 'lat', 'lon' ] ); + while ( my $row = $res->hash ) { + $latlon_by_eva{ $row->{eva} } = $row; + $latlon_by_name{ $row->{name} } = $row; + } + + my $total + = $db->select( 'journeys', 'count(*) as count' )->hash->{count}; + my $count = 0; + my $total_no_eva = 0; + my $total_no_latlon = 0; + + my $json = JSON->new; + + $res = $db->select( 'journeys_str', [ 'route', 'journey_id' ] ); + while ( my $row = $res->expand->hash ) { + my $no_eva = 0; + my $no_latlon = 0; + my $changed = 0; + my @route = @{ $row->{route} }; + for my $stop (@route) { + my $name = $stop->[0]; + my $eva = $stop->[1]; + + if ( not $eva and $stop->[2]{eva} ) { + $eva = $stop->[1] = 0 + $stop->[2]{eva}; + } + + if ( $stop->[2]{eva} and $eva and $eva == $stop->[2]{eva} ) { + delete $stop->[2]{eva}; + } + + if ( $stop->[2]{name} and $name eq $stop->[2]{name} ) { + delete $stop->[2]{name}; + } + + if ( not $eva ) { + if ( $latlon_by_name{$name} ) { + $eva = $stop->[1] = $latlon_by_name{$name}{eva}; + $changed = 1; + } + elsif ( $legacy_to_new{$name} + and $latlon_by_name{ $legacy_to_new{$name} } ) + { + $eva = $stop->[1] + = $latlon_by_name{ $legacy_to_new{$name} }{eva}; + $stop->[2]{lat} + = $latlon_by_name{ $legacy_to_new{$name} }{lat}; + $stop->[2]{lon} + = $latlon_by_name{ $legacy_to_new{$name} }{lon}; + $changed = 1; + } + else { + $no_eva = 1; + } + } + + if ( $stop->[2]{lat} and $stop->[2]{lon} ) { + next; + } + + if ( $eva and $latlon_by_eva{$eva} ) { + $stop->[2]{lat} = $latlon_by_eva{$eva}{lat}; + $stop->[2]{lon} = $latlon_by_eva{$eva}{lon}; + $changed = 1; + } + elsif ( $latlon_by_name{$name} ) { + $stop->[2]{lat} = $latlon_by_name{$name}{lat}; + $stop->[2]{lon} = $latlon_by_name{$name}{lon}; + $changed = 1; + } + elsif ( $legacy_to_new{$name} + and $latlon_by_name{ $legacy_to_new{$name} } ) + { + $stop->[2]{lat} + = $latlon_by_name{ $legacy_to_new{$name} }{lat}; + $stop->[2]{lon} + = $latlon_by_name{ $legacy_to_new{$name} }{lon}; + $changed = 1; + } + else { + $no_latlon = 1; + } + } + if ($no_eva) { + $total_no_eva += 1; + } + if ($no_latlon) { + $total_no_latlon += 1; + } + if ($changed) { + $db->update( + 'journeys', + { + route => $json->encode( \@route ), + }, + { id => $row->{journey_id} } + ); + } + if ( $count++ % 10000 == 0 ) { + printf( " %2.0f%% complete\n", $count * 100 / $total ); + } + } + say ' done'; + if ($total_no_eva) { + printf( " (%d of %d routes still lack some EVA IDs)\n", + $total_no_eva, $total ); + } + if ($total_no_latlon) { + printf( " (%d of %d routes still lack some lat/lon data)\n", + $total_no_latlon, $total ); + } + + $db->query( + qq{ + update schema_version set version = 54; + } + ); + }, + ); sub sync_stations { diff --git a/lib/Travelynx/Controller/Traveling.pm b/lib/Travelynx/Controller/Traveling.pm index f9bc2d5..2b86688 100755 --- a/lib/Travelynx/Controller/Traveling.pm +++ b/lib/Travelynx/Controller/Traveling.pm @@ -1323,8 +1323,6 @@ sub commute { sub map_history { my ($self) = @_; - my $location = $self->app->coordinates_by_station; - if ( not $self->param('route_type') ) { $self->param( route_type => 'polybee' ); } diff --git a/lib/Travelynx/Model/Journeys.pm b/lib/Travelynx/Model/Journeys.pm index 8c29e7d..b067d78 100755 --- a/lib/Travelynx/Model/Journeys.pm +++ b/lib/Travelynx/Model/Journeys.pm @@ -1120,9 +1120,8 @@ sub get_travel_distance { my $distance_beeline = 0; my $skipped = 0; my $geo = GIS::Distance->new(); - my @stations = map { $_->[0] } @{$route_ref}; - my @route = after_incl { $_ eq $from } @stations; - @route = before_incl { $_ eq $to } @route; + my @route = after_incl { $_->[0] eq $from } @{$route_ref}; + @route = before_incl { $_->[0] eq $to } @route; if ( @route < 2 ) { @@ -1144,16 +1143,16 @@ sub get_travel_distance { $prev_station = $station; } - $prev_station = $self->{latlon_by_station}->{ shift @route }; - if ( not $prev_station ) { + if ( not( defined $route[0][2]{lat} and defined $route[0][2]{lon} ) ) { return ( $distance_polyline, 0, 0 ); } - for my $station_name (@route) { - if ( my $station = $self->{latlon_by_station}->{$station_name} ) { + $prev_station = shift @route; + for my $station (@route) { + if ( defined $station->[2]{lat} and defined $station->[2]{lon} ) { $distance_intermediate += $geo->distance_metal( - $prev_station->[0], $prev_station->[1], - $station->[0], $station->[1] + $prev_station->[2]{lat}, $prev_station->[2]{lon}, + $station->[2]{lat}, $station->[2]{lon} ); $prev_station = $station; } -- cgit v1.2.3