diff --git a/lib/App/MasterUtils.pm b/lib/App/MasterUtils.pm
index c74110b1035d540fcb3d4893f86159772866cf4e..1d212d1dda13ef0889c5e2fe31488f79386e0db7 100644
--- a/lib/App/MasterUtils.pm
+++ b/lib/App/MasterUtils.pm
@@ -93,8 +93,15 @@ sub search_eki
}
else
{
- my $final = @results[0];
- return $final->{'index'};
+ if (scalar @results > 1)
+ {
+ Log::w "Ambiguous search for query $query";
+ }
+ else
+ {
+ my $final = $results[0];
+ return $final->{'index'};
+ }
}
}
diff --git a/lib/App/Navi.pm b/lib/App/Navi.pm
index 08489d923d5903f7612ce7b474ad15546e138008..ed44e8a943c7c5c14e6f4798c6201ec860282efb 100644
--- a/lib/App/Navi.pm
+++ b/lib/App/Navi.pm
@@ -214,11 +214,43 @@ sub Raptor_simple
}
}
+
+ my @next_marked;
+ # Look at foot-paths
+ foreach my $ref (@marked)
+ {
+ if ($ref->{'direction'} == 1) { next; }
+ my $p = $ref->{'eki'};
+ foreach my $fp (@{ $master->{'transfer_times'} })
+ {
+ my $pprime;
+ if ($fp->{'where'}->[0] eq $p)
+ {
+ $pprime = $fp->{'where'}->[1];
+ }
+ if ($fp->{'where'}->[1] eq $p)
+ {
+ $pprime = $fp->{'where'}->[0];
+ }
+ if (defined $pprime)
+ {
+ $taus{$pprime}[$k] = min
+ $taus{$pprime}[$k],
+ $taus{$p}[$k] + $fp->{'time'}
+ ;
+ push @next_marked, { eki => $pprime, direction => 0 };
+ push @next_marked, { eki => $pprime, direction => 1 };
+ $from{$pprime} = $p;
+ Log::d "Marking station $pprime";
+ }
+ }
+ }
+
+ push @marked, @next_marked;
- if ($#Q == 0)
+ if (scalar @Q == 0)
{
- # TODO return a route
- return;
+ last;
}
}
@@ -231,9 +263,27 @@ sub Raptor_simple
while ($pos ne $from_id)
{
- unshift @legs, $earliest{$pos};
-
my $source = $from{$pos};
+
+ # Was this station reached on foot?
+ my $on_foot = 0;
+ foreach my $transfer (@{ $master->{'transfer_times'} })
+ {
+ my $where = $transfer->{'where'};
+ if ($where->[0] eq $pos && $where->[1] eq $source ||
+ $where->[0] eq $source && $where->[1] eq $pos)
+ {
+ $on_foot = 1;
+ unshift @legs, $transfer;
+ last;
+ }
+ }
+
+ if (!$on_foot)
+ {
+ unshift @legs, $earliest{$pos};
+ }
+
$pos = $source;
unshift @path, $pos;
}
@@ -243,7 +293,7 @@ sub Raptor_simple
{
my %eki_jikoku = ( 'chaku' => undef, 'hatsu' => undef );
- if ($i != $#path)
+ if ($i != $#path and !defined $legs[$i]->{'time'})
{
my $next_frame = $earliest{$path[$i+1]};
my $next_eki_pos = $next_frame->{'dir'}
@@ -254,7 +304,7 @@ sub Raptor_simple
$eki_jikoku{'hatsu'} = $dep;
}
- if ($i != 0)
+ if ($i != 0 and !defined $legs[$i-1]->{'time'})
{
my $previous_frame = $earliest{$path[$i]};
my $previous_eki_pos = $previous_frame->{'dir'}
@@ -264,44 +314,63 @@ sub Raptor_simple
my $arr = Ressya::arr_time $previous_frame->{'service'}, $previous_eki_pos;
$eki_jikoku{'chaku'} = $arr;
}
-
+
push @jikoku, \%eki_jikoku;
}
# Second crawl: visual output
for (my $i = 0; $i < $#path; $i++)
{
- my $u = $legs[$i]->{'service'};
- my $r = $legs[$i]->{'rosen'};
- my $m = (defined $u->{'meisyo'}) ? ' ' . $u->{'meisyo'} : '';
-
- my $from_what = MasterUtils::get_ekimei $master, $path[$i];
- my $from_dep = $jikoku[$i]->{'hatsu'};
- my $to_what = MasterUtils::get_ekimei $master, $path[$i+1];
- my $to_arr = $jikoku[$i+1]->{'chaku'};
-
- print( (TimeUtils::format_time $from_dep)
- . "\t$from_what\n"
- . "\t|\n"
- . '(' . (TimeUtils::format_time_simple (TimeUtils::subtract_from $from_dep, $to_arr)) . ')'
- . "\t| "
- . (MasterUtils::get_rosenmei $master, $r)
- . ' '
- . (FrameUtils::get_syubetsu $master, $r, $u->{'syubetsu'})
- . "$m"
- . ' for '
- . (FrameUtils::get_destination $master, $r, $u->{'jikoku'}, 0, ($legs[$i]->{'dir'} == 0 ? 1 : 0))
- . "\n\tV\n"
- . (TimeUtils::format_time $to_arr)
- . "\t$to_what\n"
- );
- if ($i != $#path - 1)
+ if (!defined $legs[$i]->{'time'})
{
- my $to_dep = $jikoku[$i+1]->{'hatsu'};
- print( '('
- . TimeUtils::format_time_simple (TimeUtils::subtract_from $to_arr, $to_dep)
- . ")\n"
- )
+ my $u = $legs[$i]->{'service'};
+ my $r = $legs[$i]->{'rosen'};
+ my $m = (defined $u->{'meisyo'}) ? ' ' . $u->{'meisyo'} : '';
+
+ my $from_what = MasterUtils::get_ekimei $master, $path[$i];
+ my $from_dep = $jikoku[$i]->{'hatsu'};
+ my $to_what = MasterUtils::get_ekimei $master, $path[$i+1];
+ my $to_arr = $jikoku[$i+1]->{'chaku'};
+
+ print( (TimeUtils::format_time $from_dep)
+ . "\t$from_what\n"
+ . "\t|\n"
+ . '(' . (TimeUtils::format_time_simple (TimeUtils::subtract_from $from_dep, $to_arr)) . ')'
+ . "\t| "
+ . (MasterUtils::get_rosenmei $master, $r)
+ . ' '
+ . (FrameUtils::get_syubetsu $master, $r, $u->{'syubetsu'})
+ . "$m"
+ . ' for '
+ . (FrameUtils::get_destination $master, $r, $u->{'jikoku'}, 0, ($legs[$i]->{'dir'} == 0 ? 1 : 0))
+ . "\n\tV\n"
+ . (TimeUtils::format_time $to_arr)
+ . "\t$to_what\n"
+ );
+
+ if ($i != $#path - 1 && !defined $legs[$i+1]->{'time'})
+ {
+ my $to_dep = $jikoku[$i+1]->{'hatsu'};
+ print( '('
+ . TimeUtils::format_time_simple (TimeUtils::subtract_from $to_arr, $to_dep)
+ . ")\tO\n"
+ )
+ }
+ if ($i != $#path - 1 && defined $legs[$i+1]->{'time'})
+ {
+ my $to_dep = $jikoku[$i+2]->{'hatsu'};
+ my $tt = $legs[$i+1]->{'time'};
+ my $total = TimeUtils::subtract_from $to_arr, $to_dep;
+ my $wait = TimeUtils::subtract_from $tt, $total;
+ print( '<'
+ . (TimeUtils::format_time_simple $tt)
+ . ">\t:\n"
+ . '('
+ . (TimeUtils::format_time_simple $wait)
+ . ")\t:\n"
+ )
+ }
+
}
}
}
diff --git a/lib/App/Transfer.pm b/lib/App/Transfer.pm
new file mode 100644
index 0000000000000000000000000000000000000000..01d4a91c68a8c4a596cef213ebd83a882eac90c5
--- /dev/null
+++ b/lib/App/Transfer.pm
@@ -0,0 +1,28 @@
+package Transfer;
+
+use strict;
+use warnings;
+use Data::Printer;
+
+BEGIN
+{
+ unshift @INC, '.';
+}
+
+sub take_all
+{
+ shift;
+ return \@_;
+}
+
+sub format_tt
+{
+ shift;
+ my ($from, undef, $to, undef, $time) = @_;
+ my %frame;
+ $frame{'where'} = [$from, $to];
+ $frame{'time'} = $time;
+ return \%frame;
+}
+
+1;
diff --git a/src/oud2_parser.pl b/src/oud2_parser.pl
index c72ed24f567730b49568e9c3bcedad39665f8f88..29f9141497ddb8b9944d4b86ecf50939eb4c84cd 100644
--- a/src/oud2_parser.pl
+++ b/src/oud2_parser.pl
@@ -30,6 +30,7 @@ use List::Util qw(any);
use App::Log;
use App::Ts;
+use App::Transfer;
use App::Ressya;
use App::Frame;
use App::FrameUtils;
@@ -37,6 +38,29 @@ use App::MasterUtils;
use App::Dia;
use App::Navi;
+
+# transfer_times grammar
+my $tt_rules = << 'endrule'
+lexeme default = latm => 1
+:start ::= ALL
+
+ALL ::= RULE+
+ action => Transfer::take_all
+RULE ::= NAME SEP NAME SEP INT
+ action => Transfer::format_tt
+
+:lexeme ~ NAME priority => -1
+NAME ~ [^\v\.]+
+INT ~ [\d]+
+:lexeme ~ SEP priority => 2
+SEP ~ [.]
+
+:discard ~ NEWLINE
+NEWLINE ~ [\s]+
+
+endrule
+ ;
+
# .oud2 grammar
my $oud_rules = << 'endrule'
lexeme default = latm => 1
@@ -76,7 +100,6 @@ DIA_UP_SECTION ::= DIA_UP_BEGIN
HEADER_BEGIN ::= 'FileType='
- action => Dia::begin_header_section
ROSEN_BEGIN ::= 'Rosen.'
ROSEN_NAME ::= 'Rosenmei=' NAME
@@ -105,15 +128,12 @@ SYUBETSU_SUB ::= SYUBETSU_NAME
SYUBETSU_BEGIN ~ 'Ressyasyubetsu.'
SYUBETSU_NAME ::= 'Syubetsumei=' NAME
action => Dia::second
-#SYUBETSU_RYAKU ::= 'Ryakusyou=' NAME
+# SYUBETSU_RYAKU ::= 'Ryakusyou=' NAME
# action => Dia::second
DIA_BEGIN ::= 'Dia.'
- action => Dia::begin_dia_section
DIA_DOWN_BEGIN ::= 'Kudari.'
- action => Dia::dia_down_subsection
DIA_UP_BEGIN ::= 'Nobori.'
- action => Dia::dia_up_subsection
RESSYAS ::= RESSYA+
action => Dia::take_all
@@ -218,16 +238,36 @@ my $oud_grammar = Marpa::R2::Scanless::G->new(
}
);
+my $tt_grammar = Marpa::R2::Scanless::G->new(
+ {
+ source => \$tt_rules,
+ trace_terminals => 1,
+ }
+ );
+
my %master;
my $dias_path = $ARGV[0];
my $default_path = 'tests/dia/kyogoku.oud2';
my $root_path = (defined $dias_path) ? $dias_path : '../oud2/';
my $trains_path = $root_path . 'train/';
-
-opendir my $dir, $trains_path or die "Error opening $trains_path";
-my @trains = readdir $dir;
-closedir $dir;
+my $bus_path = $root_path . 'bus/';
+my $tt_path = $root_path . 'transfer_times';
+
+opendir my $tdir, $trains_path or die "Error opening $trains_path";
+opendir my $bdir, $bus_path or die "Error opening $bus_path";
+my @trains = readdir $tdir;
+my @bus = readdir $bdir;
+closedir $tdir;
+closedir $bdir;
+
+sub new_recce { return Marpa::R2::Scanless::R->new(
+ {
+ grammar => $oud_grammar,
+ trace_terminals => 0,
+ }
+ );
+}
# Parsing step.
# Build "temporary" frames for each diagram.
@@ -238,12 +278,7 @@ foreach my $file (@trains)
my $dia_file;
# We need to rebuild the recognizer for each file.
# This is actually a Marpa limitation.
- my $recce = Marpa::R2::Scanless::R->new(
- {
- grammar => $oud_grammar,
- trace_terminals => 0,
- }
- );
+ my $recce = new_recce ();
my $train_path = $trains_path . $file;
print 'Using file ' . $train_path . "\n";
@@ -263,6 +298,43 @@ foreach my $file (@trains)
my %frame = %{ ${$recce->value()} };
$frame{'id'} = $basename;
+ $frame{'is_train'} = 1;
+ Frame::frame_info \%frame;
+
+ $master{'rosen'}{$basename} = \%frame;
+
+ close $dia_file;
+}
+
+# Same thing with busses.
+foreach my $file (@bus)
+{
+ next if ($file =~ /^\.+$/);
+
+ my $dia_file;
+ # We need to rebuild the recognizer for each file.
+ # This is actually a Marpa limitation.
+ my $recce = new_recce ();
+
+ my $abus_path = $bus_path . $file;
+ print 'Using file ' . $abus_path . "\n";
+ open $dia_file, '<:encoding(UTF-8):via(File::BOM)', $abus_path;
+
+ my $file_name = basename $file;
+ my $basename = substr $file_name, 0, -5;
+ print "Route id will be $basename\n";
+
+ read $dia_file, my $contents, -s $dia_file;
+
+ try { print $recce->read(\$contents) . ' bytes read.'; }
+ catch ($e) { print "Malformation in .oud file.\n$e\n"; }
+ print "\n";
+
+ # print $recce->show_progress();
+
+ my %frame = %{ ${$recce->value()} };
+ $frame{'id'} = $basename;
+ $frame{'is_train'} = 0;
Frame::frame_info \%frame;
$master{'rosen'}{$basename} = \%frame;
@@ -280,6 +352,8 @@ foreach my $file (@trains)
my @master_ekis;
foreach my $frame (values %{ $master{'rosen'} })
{
+ my $is_train = $frame->{'is_train'};
+
my @old_ekis = @{ $frame->{'eki'} };
my @new_ekis;
my %dict;
@@ -311,14 +385,15 @@ foreach my $frame (values %{ $master{'rosen'} })
if ($restart) { next; }
# TODO Station has already been processed in another route
- foreach my $old (keys %{ $master{'eki_index'} })
+ foreach my $existing (keys %{ $master{'eki_index'} })
{
- my $old_ref = MasterUtils::sta_from_id \%master, $old;
- if ($old_ref->{'ekimei'} eq $ekimei)
+ my $existing_ref = MasterUtils::sta_from_id \%master, $existing;
+ if ($existing_ref->{'ekimei'} eq $ekimei &&
+ $existing_ref->{'found_as_train_stop'} == $is_train)
{
- Log::i "Found $ekimei in the existing index (first found in " . $old_ref->{'found_in'} . " with id $old)";
+ Log::i "Found $ekimei in the existing index (first found in " . $existing_ref->{'found_in'} . " with id $existing)";
Log::i "Assuming this is the same station as the one processed earlier.";
- push @new_ekis, $old;
+ push @new_ekis, $existing;
$restart = 1;
last;
}
@@ -330,6 +405,7 @@ foreach my $frame (values %{ $master{'rosen'} })
print "Adding station $ekimei to master frame with id $id\n";
$new_struct{'ekimei'} = $ekimei;
$new_struct{'found_in'} = $frame->{'id'};
+ $new_struct{'found_as_train_stop'} = $is_train;
$master{'eki_index'}{$id} = \%new_struct;
push @new_ekis, $id;
@@ -342,9 +418,44 @@ foreach my $frame (values %{ $master{'rosen'} })
$frame->{'eki'} = \@new_ekis;
}
+# Parse transfer times
+my $recce = Marpa::R2::Scanless::R->new(
+ {
+ grammar => $tt_grammar,
+ trace_terminals => 0,
+ }
+ );
+open my $tt_file, '<:encoding(UTF-8):via(File::BOM)', $tt_path;
+
+print "Parsing transfer times\n";
+
+read $tt_file, my $tt_contents, -s $tt_file;
+try { print $recce->read(\$tt_contents) . ' bytes read.'; }
+catch ($e) { print "Malformation in transfer_times file.\n$e\n"; }
+print "\n";
+
+my $transfers = ${ $recce->value() };
+foreach my $transfer (@$transfers)
+{
+ my $where = $transfer->{'where'};
+ my $time = $transfer->{'time'};
+ print "Transfer time is $time' between $where->[0] and $where->[1]\n";
+ $transfer->{'where'} =
+ [
+ (MasterUtils::search_eki \%master, $where->[0]),
+ (MasterUtils::search_eki \%master, $where->[1])
+ ];
+}
+
+$master{'transfer_times'} = $transfers;
+
# FrameUtils::hassya_hyou \%master, 'sekihoku1_28';
-my $d = MasterUtils::search_eki \%master, '幾寅';
-my $a = MasterUtils::search_eki \%master, '音別';
+my $d = MasterUtils::search_eki \%master, '以久科';
+my $a = MasterUtils::search_eki \%master, '五十嵐';
+
+sub eki { return MasterUtils::search_eki \%master, $_[0]; }
+
+Navi::Raptor_simple \%master, $d, $a, 640;
-Navi::Raptor_simple \%master, $d, $a, 334;
+# FrameUtils::hassya_hyou \%master, (eki '古瀬');