chiark / gitweb /
wip
authorIan Jackson <ijackson@chiark.greenend.org.uk>
Mon, 14 Jan 2019 01:05:14 +0000 (01:05 +0000)
committerIan Jackson <ijackson@chiark.greenend.org.uk>
Mon, 14 Jan 2019 01:05:14 +0000 (01:05 +0000)
parse-input-graph

index 28178fbd118cfded5ad5e1225dd741397feb3835..623e2563365c99e880fc85d724dbcbbcaeef443b 100755 (executable)
@@ -7,9 +7,11 @@ use Data::Dumper;
 our %region;
 # $region{NAME}{Colour}
 # $region{NAME}{Water}
+# $region{NAME}{L}
 # $region{NAME}{Adj}[]{Name}
 # $region{NAME}{Adj}[]{Regexp}
 # $region{NAME}{Adj}[]{Dikes}
+# $region{NAME}{Adj}[]{L}
 
 sub read_in () {
   my $ccolour;
@@ -23,16 +25,17 @@ sub read_in () {
       $ccolour = $&;
       next;
     }
-    if (my ($name, $water) = m{^\t(\S.*\S)(?: \[(\d+)\])?$}) {
+    if (my ($name, $water) = m{^\t(\S.*\w)(?: \[(\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, $adykes) = m{^\t\t(\S.*\S)(?: (\+\+?))?$}) {
-      my $adj = { Dykes => length $adykes };
+    if (my ($aref, $adykes) = m{^\t\t(\S.*[A-Za-z.])(?: (\+\+?))?$}) {
+      my $adj = { Dykes => length $adykes, L => $. };
       if ($aref =~ m{\.}) {
        $aref =~ s{\-}{[^- ]*-};
        $aref =~ s{\.}{[^- ]* ?};
@@ -51,21 +54,26 @@ sub unique_aref ($$) {
   my ($ra, $adja) = @_;
   my $re = $adja->{Regexp};
   return $adja->{Name} unless defined $re;
-  my @found;
+  my @cands;
   foreach my $rb (sort keys %region) {
-    next unless $rb =~ m{^$re$};
-    foreach my $adjb (@{ $region{rb}{Adj} }) {
+    #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;
     }
   }
-  confess "$ra $re @found ?" unless @found==1;
+  my @found = grep { m{^$re$} } @cands;
+  local $" = ' / ';
+  confess "$adja->{L} $ra $re | @cands | @found | ?" unless @found==1;
   print "resolve $ra -> $re  as @found\n";
   return $found[1];
 }   
 
 sub resolve_arefs () {
+  #print Dumper(\%region);
   foreach my $ra (sort keys %region) {
     foreach my $adj (@{ $region{$ra}{Adj} }) {
       next if defined $adj->{Name};