10 our @ISA = qw(Exporter);
11 our @EXPORT = qw(parse_input_graph o plag_prs %region %c);
14 require 'misc-data.pl';
17 # $region{NAME}{Colour}
18 # $region{NAME}{Water}
20 # $region{NAME}{L} # line number
21 # $region{NAME}{Adj}[]{Name}
22 # $region{NAME}{Adj}[]{DisplayName}[]
23 # $region{NAME}{Adj}[]{Pattern}
24 # $region{NAME}{Adj}[]{Regexp}
25 # $region{NAME}{Adj}[]{Dykes}
26 # $region{NAME}{Adj}[]{L}
29 # $adj{EARLIER}{LATER}{Dykes}
30 # $adj{EARLIER}{LATER}{L}[]
31 # $adj{EARLIER}{LATER}{T}[]
45 if (my ($name, $water) = m{^\t(\S.*\w|L2?)(?: \[(\d+)\])?$}) {
46 confess unless defined $ccolour;
47 my $dname = $c{DisplayNames}{$name} // $name;
49 confess "$name ?" if $region{$name};
50 $region{$name}{Colour} = $ccolour;
51 $region{$name}{Water} = $water;
52 $region{$name}{L} = $.;
54 $dname =~ s{(?<!-)/(?! )}{-/}g;
55 $region{$name}{DisplayName} = [ grep m/./, split m{ */ *}, $dname ];
57 $region{$name}{DisplayName} = [ split m{(?<=-)| }, $dname ];
62 if (my ($aref, $adykes, $dwdyke) =
63 m{^\t\t(\S.*[A-Za-z.]|L2?)(?: (\+\+?)(\@?))?$}) {
65 Dykes => (length $adykes // 0),
66 Deltawerk => !!$dwdyke,
70 $adj->{Pattern} = $aref;
71 $aref =~ s{\-}{[^- ]*-}g;
73 length $& eq 1 ? qr{[^- ]* ?} :
74 length $& eq 2 ? qr{.*} : confess "$aref"
76 $adj->{Regexp} = $aref;
80 push @{ $region{$cregion}{Adj} }, $adj;
87 sub unique_aref ($$) {
89 my $re = $adja->{Regexp};
90 return $adja->{Name} unless defined $re;
92 foreach my $rb (sort keys %region) {
93 #print STDERR "?? $ra -> $re $rb ?\n";
94 foreach my $adjb (@{ $region{$rb}{Adj} }) {
95 my $adjbn = $adjb->{Name};
96 next unless defined $adjbn;
97 #print STDERR "?? $ra -> $re $rb ?? $adjbn\n";
98 next unless $adjbn eq $ra;
99 push @cands, [ $rb, "$region{$rb}{L},$adjb->{L}" ];
102 my @found = grep { $_->[0] =~ m{^$re$} } @cands;
104 join ' / ', map { "$_->[0] ($_->[1])" } @_;
106 confess "$adja->{L} $adja->{Pattern} /$re/ | ".$pr->(@cands)
107 ." | ".$pr->(@found)." | ?"
109 my $r = $found[0][0];
110 #print STDERR "resolve $ra -> $adja->{Pattern} = $r\n";
115 ($a eq 'L' ) <=> ($b eq 'L' ) or
116 ($a eq 'L2') <=> ($b eq 'L2') or
117 ($a eq 'NZ') <=> ($b eq 'NZ') or
121 sub resolve_arefs () {
122 #print Dumper(\%region);
123 foreach my $ra (sort keys %region) {
124 foreach my $adj (@{ $region{$ra}{Adj} }) {
125 next if defined $adj->{Name};
126 $adj->{ProspectiveName} = unique_aref $ra, $adj;
129 foreach my $ra (sort keys %region) {
130 foreach my $adj (@{ $region{$ra}{Adj} }) {
131 $adj->{Name} //= $adj->{ProspectiveName};
134 foreach my $ra (sort keys %region) {
135 foreach my $adj (@{ $region{$ra}{Adj} }) {
136 confess unless $adj->{Name} eq unique_aref $ra, $adj;
142 foreach my $ra (sort keys %region) {
143 my $adjs = $region{$ra}{Adj};
144 foreach my $adji (0..$#$adjs) {
145 my $adja = $adjs->[$adji];
146 my $rb = $adja->{Name};
147 my ($r0,$r1) = sort region_cmp ($ra,$rb);
148 push @{ $adj{$r0}{$r1}{L} }, $adja->{L};
149 push @{ $adj{$r0}{$r1}{T} }, substr($ra,0,1)."#".$adji;
150 my $e = $adj{$r0}{$r1};
151 $e->{Dykes} //= $adja->{Dykes};
152 confess "$r0 - $r1 | @{ $e->{L} } | $e->{Dykes} $adja->{Dykes} ?"
153 unless $e->{Dykes} == $adja->{Dykes};
157 foreach my $r0 (sort keys %adj) {
158 foreach my $r1 (sort keys %{ $adj{$r0} }) {
159 my $e = $adj{$r0}{$r1};
160 confess "$r0 / $r1 : @{ $e->{L} } ?" unless @{ $e->{L} } == 2;
161 $ndykes += $e->{Dykes};
164 #print STDERR "total $ndykes dykes\n";
168 foreach my $r (sort keys %region) {
169 $region{$r}{Name} = $r;
173 sub edge_id_to_other_id ($$) {
174 my ($ra, $adjia) = @_;
175 my $adjsa = $region{$ra}{Adj};
176 my $adja = $adjsa->[$adjia];
177 my $rb = $adja->{Name};
178 my $adjsb = $region{$rb}{Adj};
179 foreach my $adjib (0..$#$adjsb) {
180 my $adjb = $adjsb->[$adjib];
181 next unless $adjb->{Name} eq $ra;
182 # $adjb is the same edge seen from the other side
183 return ($rb, $adjib);
185 confess "$ra $adjia ?";
188 sub o { print @_ or die $!; }
192 $t = $` if $t =~ m/\n/;
198 sub parse_input_graph () {