mirror of
https://github.com/flohoff/routecompare.git
synced 2024-09-21 07:47:08 +00:00
dafa7be80e
Try to filter out diffs where the route never reaches the same destination. This can happen when the random location is far of the road network and the snap-on road is not in the graph anymore due to profile changes. This may also happen on the edges of your area/pbf file.
187 lines
3.9 KiB
Perl
Executable File
187 lines
3.9 KiB
Perl
Executable File
#!/usr/bin/perl
|
|
|
|
|
|
package Route::Waypoint::Location;
|
|
use strict;
|
|
no warnings "experimental::signatures";
|
|
use feature 'signatures';
|
|
|
|
sub new($class, $location) {
|
|
my $self={
|
|
lon => $location->[0],
|
|
lat => $location->[1]
|
|
};
|
|
|
|
bless $self, $class;
|
|
|
|
return $self;
|
|
}
|
|
|
|
sub lon($self) {
|
|
return $self->{lon};
|
|
}
|
|
|
|
sub lat($self) {
|
|
return $self->{lat};
|
|
}
|
|
|
|
sub equal($self, $other) {
|
|
return $self->lat() eq $other->lat() &&
|
|
$self->lon() eq $other->lon();
|
|
}
|
|
1;
|
|
|
|
package Route::Waypoint;
|
|
use strict;
|
|
no warnings "experimental::signatures";
|
|
use feature 'signatures';
|
|
use Data::Dumper;
|
|
|
|
sub new($class, $route) {
|
|
bless $route, $class;
|
|
return $route;
|
|
}
|
|
|
|
sub distance($self) {
|
|
return $self->{distance};
|
|
}
|
|
|
|
sub location($self) {
|
|
return new Route::Waypoint::Location($self->{location});
|
|
}
|
|
1;
|
|
|
|
package Route;
|
|
use strict;
|
|
no warnings "experimental::signatures";
|
|
use feature 'signatures';
|
|
use Data::Dumper;
|
|
|
|
sub new($class, $route, $waypoints) {
|
|
bless $route, $class;
|
|
|
|
$route->{waypoints}=[ map { new Route::Waypoint($_) } @{$waypoints} ];
|
|
|
|
return $route;
|
|
}
|
|
|
|
sub duration($self) {
|
|
return $self->{duration}*1;
|
|
}
|
|
|
|
sub distance($self) {
|
|
return $self->{distance}*1;
|
|
}
|
|
|
|
sub waypoints($self) {
|
|
return $self->{waypoints};
|
|
}
|
|
|
|
sub waypoint_start($self) {
|
|
return $self->{waypoints}[0];
|
|
}
|
|
|
|
sub waypoint_end($self) {
|
|
return $self->{waypoints}[1];
|
|
}
|
|
1;
|
|
|
|
# http://localhost:8080/osrmb/route/v1/car/8.351497650146486,51.89863463469904;8.36686134338379,51.916691123199826?geometries=geojson
|
|
|
|
use strict;
|
|
no warnings "experimental::signatures";
|
|
use feature 'signatures';
|
|
use LWP::UserAgent;
|
|
use FindBin qw($RealBin $Bin);
|
|
use File::Slurp qw/read_file/;
|
|
use Getopt::Long::Descriptive;
|
|
use Data::Dumper;
|
|
use JSON;
|
|
|
|
|
|
my $uribase="http://localhost:8080";
|
|
my $waypointsfile=$ARGV[0];
|
|
my $numroutes=$ARGV[1];
|
|
|
|
sub calcroute($ua, $uribase, $osrmi, $profile, $lng1, $lat1, $lng2, $lat2) {
|
|
|
|
my $uri=sprintf("%s/%s/route/v1/%s/%f,%f;%f,%f?geometries=geojson&overview=full&annotations=true&steps=true&alternatives=true",
|
|
$uribase, $osrmi, $profile,
|
|
$lng1, $lat1,
|
|
$lng2, $lat2);
|
|
|
|
my $response=$ua->get($uri);
|
|
|
|
if (!$response->is_success) {
|
|
printf("Failed to get %s\n", $uri);
|
|
return undef;
|
|
}
|
|
|
|
my $j=from_json($response->decoded_content);
|
|
|
|
return new Route($j->{routes}[0], $j->{waypoints});
|
|
}
|
|
|
|
my ($opt, $usage) = describe_options(
|
|
'$Bin %o <some-arg>',
|
|
[ 'minx=s', "Min X" ],
|
|
[ 'maxx=s', "Max X"],
|
|
[ 'miny=s', "Min Y" ],
|
|
[ 'maxy=s', "Max Y" ],
|
|
[ 'maxdistance=i', "Max distance to road network at start and end", { default => 3000 } ],
|
|
[ 'sei', "Start and End identical only" ],
|
|
[],
|
|
[ 'help', "print usage message and exit", { shortcircuit => 1 } ],
|
|
);
|
|
|
|
print($usage->text), exit if $opt->help;
|
|
|
|
sub genpoint($opt) {
|
|
return [
|
|
$opt->minx+rand($opt->maxx-$opt->minx),
|
|
$opt->miny+rand($opt->maxy-$opt->miny)
|
|
];
|
|
}
|
|
|
|
my $ua=LWP::UserAgent->new(timeout => 2);
|
|
|
|
while(42) {
|
|
my $p1=genpoint($opt);
|
|
my $p2=genpoint($opt);
|
|
|
|
my $a=calcroute($ua, $uribase, "osrma", "car", $p1->[0], $p1->[1], $p2->[0], $p2->[1]);
|
|
my $b=calcroute($ua, $uribase, "osrmb", "car", $p1->[0], $p1->[1], $p2->[0], $p2->[1]);
|
|
|
|
if (!defined($a) || !defined($b)) {
|
|
next;
|
|
}
|
|
|
|
if ($a->distance() ne $b->distance() && $a->duration() ne $b->duration) {
|
|
|
|
# Dont show as changed when distance to road network is larger
|
|
# than maxdistance. Most likely we are outside of our PBF file.
|
|
my @wp=grep { $_->distance() > $opt->maxdistance } @{$a->waypoints()};
|
|
|
|
if (scalar @wp > 0) {
|
|
next;
|
|
}
|
|
|
|
if ($opt->sei) {
|
|
if (!$a->waypoint_start()->location()->equal($b->waypoint_start()->location())) {
|
|
next;
|
|
}
|
|
if (!$a->waypoint_end()->location()->equal($b->waypoint_end()->location())) {
|
|
next;
|
|
}
|
|
}
|
|
|
|
printf("http://localhost:8080/?route=%f,%f,%f,%f\n",
|
|
$p1->[0], $p1->[1], $p2->[0], $p2->[1]);
|
|
|
|
printf("\tDistance diff: %f Duration diff: %f\n",
|
|
$b->distance()-$a->distance(), $b->duration-$a->duration);
|
|
|
|
|
|
}
|
|
}
|