map.dot
map.ps
map.plag
+opt.plag
+.opt.plag.sums
+*.tmp
-o= >$@.tmp && mv -f $@.tmp $@
+i=mv -f $@.tmp $@
+o= >$@.tmp && $i
export PERL_HASH_SEED=1
-map.plag: parse-input-graph input-graph
- ./$^ $o
+PLANAR_GRAPH=planar-graph
+
+map.plag: parse-input-graph input-graph Parse.pm
+ ./$< input-graph $o
+
+opt.plag: map.plag $(PLANAR_GRAPH)
+ sha256sum $^ >.opt.plag.sums.tmp
+ cmp .opt.plag.sums.tmp .opt.plag.sums || ( \
+ $(PLANAR_GRAPH) RF $< \
+ DUAL \
+ OUTER-F2V OUTER-SPLIT \
+ B T OUTER-F2V OUTER-F12VA \
+ PCO CP RAE \
+ D 0 NLOPT \
+ W $@.tmp \
+ && $i \
+ && mv -vf .opt.plag.sums.tmp .opt.plag.sums )
#map.ps: map.dot
# neato -Tps $^ $o
--- /dev/null
+
+package Parse;
+
+use strict;
+use Carp;
+use Graph;
+
+use Exporter;
+
+our @ISA = qw(Exporter);
+our @EXPORT = qw(parse_input_graph o %region %adj);
+
+our %region;
+# $region{NAME}{Colour}
+# $region{NAME}{Water}
+# $region{NAME}{L} # line number
+# $region{NAME}{Adj}[]{Name}
+# $region{NAME}{Adj}[]{Pattern}
+# $region{NAME}{Adj}[]{Regexp}
+# $region{NAME}{Adj}[]{Dikes}
+# $region{NAME}{Adj}[]{L}
+
+our %adj;
+# $adj{EARLIER}{LATER}{Dikes}
+# $adj{EARLIER}{LATER}{L}[]
+# $adj{EARLIER}{LATER}{T}[]
+
+sub read_in () {
+ my $ccolour;
+ my $cregion;
+
+ while (<>) {
+ next if m{^\s*\#};
+ next unless m{\S};
+ s{\s+$}{} or confess;
+ if (m{^\w+}) {
+ $ccolour = $&;
+ next;
+ }
+ if (my ($name, $water) = m{^\t(\S.*\w|L)(?: \[(\d+)\])?$}) {
+ confess unless defined $ccolour;
+ confess "$name ?" if $region{$name};
+ $region{$name}{Colour} = $ccolour;
+ $region{$name}{Water} = $water;
+ $region{$name}{L} = $.;
+ $cregion = $name;
+ next;
+ }
+ if (my ($aref, $adikes) = m{^\t\t(\S.*[A-Za-z.]|L)(?: (\+\+?))?$}) {
+ my $adj = { Dikes => (length $adikes // 0), L => $. };
+ if ($aref =~ m{\.}) {
+ $adj->{Pattern} = $aref;
+ $aref =~ s{\-}{[^- ]*-}g;
+ $aref =~ s{\.+}{
+ length $& eq 1 ? qr{[^- ]* ?} :
+ length $& eq 2 ? qr{.*} : confess "$aref"
+ }ge;
+ $adj->{Regexp} = $aref;
+ } else {
+ $adj->{Name} = $aref;
+ }
+ push @{ $region{$cregion}{Adj} }, $adj;
+ next;
+ }
+ confess "$_ ?";
+ }
+}
+
+sub unique_aref ($$) {
+ my ($ra, $adja) = @_;
+ my $re = $adja->{Regexp};
+ return $adja->{Name} unless defined $re;
+ my @cands;
+ foreach my $rb (sort keys %region) {
+ #print STDERR "?? $ra -> $re $rb ?\n";
+ foreach my $adjb (@{ $region{$rb}{Adj} }) {
+ my $adjbn = $adjb->{Name};
+ next unless defined $adjbn;
+ #print STDERR "?? $ra -> $re $rb ?? $adjbn\n";
+ next unless $adjbn eq $ra;
+ push @cands, [ $rb, "$region{$rb}{L},$adjb->{L}" ];
+ }
+ }
+ my @found = grep { $_->[0] =~ m{^$re$} } @cands;
+ my $pr = sub {
+ join ' / ', map { "$_->[0] ($_->[1])" } @_;
+ };
+ confess "$adja->{L} $adja->{Pattern} /$re/ | ".$pr->(@cands)
+ ." | ".$pr->(@found)." | ?"
+ unless @found==1;
+ my $r = $found[0][0];
+ #print STDERR "resolve $ra -> $adja->{Pattern} = $r\n";
+ return $r;
+}
+
+sub region_cmp {
+ ($a eq 'L' ) <=> ($b eq 'L' ) or
+ ($a eq 'NZ') <=> ($b eq 'NZ') or
+ $a cmp $b
+}
+
+sub resolve_arefs () {
+ #print Dumper(\%region);
+ foreach my $ra (sort keys %region) {
+ foreach my $adj (@{ $region{$ra}{Adj} }) {
+ next if defined $adj->{Name};
+ $adj->{ProspectiveName} = unique_aref $ra, $adj;
+ }
+ }
+ foreach my $ra (sort keys %region) {
+ foreach my $adj (@{ $region{$ra}{Adj} }) {
+ $adj->{Name} //= $adj->{ProspectiveName};
+ }
+ }
+ foreach my $ra (sort keys %region) {
+ foreach my $adj (@{ $region{$ra}{Adj} }) {
+ confess unless $adj->{Name} eq unique_aref $ra, $adj;
+ }
+ }
+}
+
+sub adjacencies () {
+ foreach my $ra (sort keys %region) {
+ my $adjs = $region{$ra}{Adj};
+ foreach my $adji (0..$#$adjs) {
+ my $adja = $adjs->[$adji];
+ my $rb = $adja->{Name};
+ my ($r0,$r1) = sort region_cmp ($ra,$rb);
+ push @{ $adj{$r0}{$r1}{L} }, $adja->{L};
+ push @{ $adj{$r0}{$r1}{T} }, substr($ra,0,1)."#".$adji;
+ my $e = $adj{$r0}{$r1};
+ $e->{Dikes} //= $adja->{Dikes};
+ confess "$r0 - $r1 | @{ $e->{L} } | $e->{Dikes} $adja->{Dikes} ?"
+ unless $e->{Dikes} == $adja->{Dikes};
+ }
+ }
+ my $ndikes = 0;
+ foreach my $r0 (sort keys %adj) {
+ foreach my $r1 (sort keys %{ $adj{$r0} }) {
+ my $e = $adj{$r0}{$r1};
+ confess "$r0 / $r1 : @{ $e->{L} } ?" unless @{ $e->{L} } == 2;
+ $ndikes += $e->{Dikes};
+ }
+ }
+ #print STDERR "total $ndikes dikes\n";
+}
+
+sub edge_id_to_other_id ($$) {
+ my ($ra, $adjia) = @_;
+ my $adjsa = $region{$ra}{Adj};
+ my $adja = $adjsa->[$adjia];
+ my $rb = $adja->{Name};
+ my $adjsb = $region{$rb}{Adj};
+ foreach my $adjib (0..$#$adjsb) {
+ my $adjb = $adjsb->[$adjib];
+ next unless $adjb->{Name} eq $ra;
+ # $adjb is the same edge seen from the other side
+ return ($rb, $adjib);
+ }
+ confess "$ra $adjia ?";
+}
+
+sub o { print @_ or die $!; }
+
+sub parse_input_graph () {
+ read_in();
+ resolve_arefs();
+ adjacencies();
+}
+
+1;
use strict;
use Carp;
-use Data::Dumper;
-use Graph;
-use List::MoreUtils qw(any);
-our %region;
-# $region{NAME}{Colour}
-# $region{NAME}{Water}
-# $region{NAME}{L} # line number
-# $region{NAME}{Adj}[]{Name}
-# $region{NAME}{Adj}[]{Pattern}
-# $region{NAME}{Adj}[]{Regexp}
-# $region{NAME}{Adj}[]{Dikes}
-# $region{NAME}{Adj}[]{L}
+BEGIN { unshift @INC, qw(.); }
-our %adj;
-# $adj{EARLIER}{LATER}{Dikes}
-# $adj{EARLIER}{LATER}{L}[]
-# $adj{EARLIER}{LATER}{T}[]
-
-sub read_in () {
- my $ccolour;
- my $cregion;
-
- while (<>) {
- next if m{^\s*\#};
- next unless m{\S};
- s{\s+$}{} or confess;
- if (m{^\w+}) {
- $ccolour = $&;
- next;
- }
- if (my ($name, $water) = m{^\t(\S.*\w|L)(?: \[(\d+)\])?$}) {
- confess unless defined $ccolour;
- confess "$name ?" if $region{$name};
- $region{$name}{Colour} = $ccolour;
- $region{$name}{Water} = $water;
- $region{$name}{L} = $.;
- $cregion = $name;
- next;
- }
- if (my ($aref, $adikes) = m{^\t\t(\S.*[A-Za-z.]|L)(?: (\+\+?))?$}) {
- my $adj = { Dikes => (length $adikes // 0), L => $. };
- if ($aref =~ m{\.}) {
- $adj->{Pattern} = $aref;
- $aref =~ s{\-}{[^- ]*-}g;
- $aref =~ s{\.+}{
- length $& eq 1 ? qr{[^- ]* ?} :
- length $& eq 2 ? qr{.*} : confess "$aref"
- }ge;
- $adj->{Regexp} = $aref;
- } else {
- $adj->{Name} = $aref;
- }
- push @{ $region{$cregion}{Adj} }, $adj;
- next;
- }
- confess "$_ ?";
- }
-}
-
-sub unique_aref ($$) {
- my ($ra, $adja) = @_;
- my $re = $adja->{Regexp};
- return $adja->{Name} unless defined $re;
- my @cands;
- foreach my $rb (sort keys %region) {
- #print STDERR "?? $ra -> $re $rb ?\n";
- foreach my $adjb (@{ $region{$rb}{Adj} }) {
- my $adjbn = $adjb->{Name};
- next unless defined $adjbn;
- #print STDERR "?? $ra -> $re $rb ?? $adjbn\n";
- next unless $adjbn eq $ra;
- push @cands, [ $rb, "$region{$rb}{L},$adjb->{L}" ];
- }
- }
- my @found = grep { $_->[0] =~ m{^$re$} } @cands;
- my $pr = sub {
- join ' / ', map { "$_->[0] ($_->[1])" } @_;
- };
- confess "$adja->{L} $adja->{Pattern} /$re/ | ".$pr->(@cands)
- ." | ".$pr->(@found)." | ?"
- unless @found==1;
- my $r = $found[0][0];
- #print STDERR "resolve $ra -> $adja->{Pattern} = $r\n";
- return $r;
-}
-
-sub region_cmp {
- ($a eq 'L' ) <=> ($b eq 'L' ) or
- ($a eq 'NZ') <=> ($b eq 'NZ') or
- $a cmp $b
-}
-
-sub resolve_arefs () {
- #print Dumper(\%region);
- foreach my $ra (sort keys %region) {
- foreach my $adj (@{ $region{$ra}{Adj} }) {
- next if defined $adj->{Name};
- $adj->{ProspectiveName} = unique_aref $ra, $adj;
- }
- }
- foreach my $ra (sort keys %region) {
- foreach my $adj (@{ $region{$ra}{Adj} }) {
- $adj->{Name} //= $adj->{ProspectiveName};
- }
- }
- foreach my $ra (sort keys %region) {
- foreach my $adj (@{ $region{$ra}{Adj} }) {
- confess unless $adj->{Name} eq unique_aref $ra, $adj;
- }
- }
-}
-
-sub adjacencies () {
- foreach my $ra (sort keys %region) {
- my $adjs = $region{$ra}{Adj};
- foreach my $adji (0..$#$adjs) {
- my $adja = $adjs->[$adji];
- my $rb = $adja->{Name};
- my ($r0,$r1) = sort region_cmp ($ra,$rb);
- push @{ $adj{$r0}{$r1}{L} }, $adja->{L};
- push @{ $adj{$r0}{$r1}{T} }, substr($ra,0,1)."#".$adji;
- my $e = $adj{$r0}{$r1};
- $e->{Dikes} //= $adja->{Dikes};
- confess "$r0 - $r1 | @{ $e->{L} } | $e->{Dikes} $adja->{Dikes} ?"
- unless $e->{Dikes} == $adja->{Dikes};
- }
- }
- my $ndikes = 0;
- foreach my $r0 (sort keys %adj) {
- foreach my $r1 (sort keys %{ $adj{$r0} }) {
- my $e = $adj{$r0}{$r1};
- confess "$r0 / $r1 : @{ $e->{L} } ?" unless @{ $e->{L} } == 2;
- $ndikes += $e->{Dikes};
- }
- }
- print STDERR "total $ndikes dikes\n";
-}
-
-sub edge_id_to_other_id ($$) {
- my ($ra, $adjia) = @_;
- my $adjsa = $region{$ra}{Adj};
- my $adja = $adjsa->[$adjia];
- my $rb = $adja->{Name};
- my $adjsb = $region{$rb}{Adj};
- foreach my $adjib (0..$#$adjsb) {
- my $adjb = $adjsb->[$adjib];
- next unless $adjb->{Name} eq $ra;
- # $adjb is the same edge seen from the other side
- return ($rb, $adjib);
- }
- confess "$ra $adjia ?";
-}
-
-sub o { print @_ or die $!; }
+use Parse;
sub plag_prs ($) {
my ($t) = @_;
}
-read_in();
-resolve_arefs();
-adjacencies();
+parse_input_graph();
output_planar_graph();
# Local variables:
~ian / pandemic-rising-tide.git / commitdiff