From d7a7f0d55b318d3db7cac6806b189b8039819a65 Mon Sep 17 00:00:00 2001 From: Ian Jackson Date: Thu, 28 Feb 2019 00:57:45 +0000 Subject: [PATCH] move stuff into Parse.pm; build system --- .gitignore | 3 + Makefile | 22 +++++- Parse.pm | 171 ++++++++++++++++++++++++++++++++++++++++++++++ parse-input-graph | 159 +----------------------------------------- 4 files changed, 196 insertions(+), 159 deletions(-) create mode 100644 Parse.pm diff --git a/.gitignore b/.gitignore index c59e76f..9733d35 100644 --- a/.gitignore +++ b/.gitignore @@ -1,3 +1,6 @@ map.dot map.ps map.plag +opt.plag +.opt.plag.sums +*.tmp diff --git a/Makefile b/Makefile index 8825b4c..f4b0e89 100644 --- a/Makefile +++ b/Makefile @@ -1,10 +1,26 @@ -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 diff --git a/Parse.pm b/Parse.pm new file mode 100644 index 0000000..51cb1fa --- /dev/null +++ b/Parse.pm @@ -0,0 +1,171 @@ + +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; diff --git a/parse-input-graph b/parse-input-graph index 2d120cb..c39e583 100755 --- a/parse-input-graph +++ b/parse-input-graph @@ -2,161 +2,10 @@ 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) = @_; @@ -179,9 +28,7 @@ sub output_planar_graph () { } -read_in(); -resolve_arefs(); -adjacencies(); +parse_input_graph(); output_planar_graph(); # Local variables: -- 2.30.2