chiark / gitweb /
wip; working on elimtrivial; considering graph manip in C instead
authorian <ian>
Sun, 13 Mar 2005 18:03:56 +0000 (18:03 +0000)
committerian <ian>
Sun, 13 Mar 2005 18:03:56 +0000 (18:03 +0000)
layout/extractgraph

index 59981ec47b5b8e06ecc5f99fff6bcaff3e5371ec..c4399a886de1a74e95f7bf4bef01f339a028ef30 100755 (executable)
@@ -58,14 +58,17 @@ our @layerkinds;
 @layerkinds= split /\,/, $conf{LayerKinds}, -1;
 
 our @nodes;
-# $nodes[$nodenum]{X}
-# $nodes[$nodenum]{Y}
-# $nodes[$nodenum]{A}
-# $nodes[$nodenum]{LayerMin}
-# $nodes[$nodenum]{LayerMax}
+# $nodes[]{X}
+# $nodes[]{Y}
+# $nodes[]{A}
+# $nodes[]{LayerMin}
+# $nodes[]{LayerMax}
+# $nodes[]{"Edges$back"}[] = [ \$edges[], $far ]
 
-our @links;
-# $links[]= [ $nodenum0, $back0, $nodenum1, $back1, $dist, $subsegspec ];
+our @edges;
+# $edges[]{"Node$far"}= [ \$nodes[], $back ]
+# $edges[]{Dist}
+# $edges[]{SubSegSpec}
 
 sub comment ($) {
     print "/* $_[0] */\n";
@@ -77,8 +80,7 @@ sub find_node (@) {
     my ($lni,$isdest,$l,$x,$y,$a) = @_;
     my ($any_outside_toler, $any_outside_clear, $updlayer);
     my ($ni, $node, %diff, $back, $d, $k);
-    for ($ni=0; $ni<@nodes; $ni++) {
-       $node= $nodes[$ni];
+    for $node (@nodes) {
        $diff{Layer}= (($d = $l - $node->{LayerMin}) < 0 ? $d :
                       ($d = $l - $node->{LayerMax}) > 0 ? $d :
                       0);
@@ -116,15 +118,16 @@ sub find_node (@) {
                $node->{"Layer$updlayer"}= $l;
                $node->{LineInfo}.="($l<-$lni)";
            }
-           comment("nodulated $lni ex.#$ni/$back");
-           return ($ni,$back);
+           trace("node $lni existing ".pnode($node)."/$back");
+           return ($node,$back);
        }
     }
     $node= { X => $x, Y => $y, A => $a,
             LayerMin => $l, LayerMax => $l, LineInfo => $lni };
+    $back= 0;
     push @nodes, $node;
-    comment("nodulated $lni new#$ni/0");
-    return ($#nodes,0);
+    trace("node $lni created ".pnode($node)."/$back");
+    return ($node,$back);
 }
 
 sub readin () {
@@ -140,21 +143,94 @@ sub readin () {
        @numbers = map { $_ + 0 } split / /, $numbers;
        $dist= shift @numbers;
        @numbers == 6 or die;
-       @nodeinfo= ();
-       for ($pti=0; $pti<2; $pti++) {
-           push @nodeinfo,
-               find_node("$.:$pti", $pti,
-                         $level, @numbers[($pti*3)..($pti*3+2)]);
+       $edge= { Dist = $dist, SubSegSpec= $subsegspec };
+       for ($far=0; $far<2; $far++) {
+           @endnums= @numbers[($far*3)..($far*3+2)];
+           ($node,$back)= find_node("$.:$far",$far,$level,@endnums);
+           $edge{"Node$far"}= [ $node, $back ];
+           push @{ $node->{"Edges$back"} }, [ $edge, $far ];
        }
-       push @links, [ @nodeinfo, $dist, $subsegspec ];
-       comment("link @{ $links[$#links] }");
+       push @edges, $edge;
     }
 }
 
+sub extendsplits () {
+    # Whenever we have a node which has one or more moveable feature
+    # subsegments, part of the same moveable feature, on one side, and
+    # fixed portion of the same segment on the other, we eliminate
+    # the fixed portion and add its length to both the moveables,
+    # so that we have one subsegspec for the whole of each position:
+    #
+    #    <---l---> <----l'---->             <--------(l+l')------>
+    #
+    #   *----A1---*----A1/P0--*  becomes  *--------A1/P0----------*
+    #              `---A1/P1---*           `-------A1/P1-----------*
+    #
+    #               <----l''--->            <--------(l+l'')------>
+
+    $pass= 0;
+    for (;;) {
+       $pass++;
+       trace("extendsplits pass $pass");
+       $any_found= 0;
+       for $node (@nodes) {
+           for ($rightback=0; $rightback<2; $rightback++) {
+               $leftback= 1-$rightback;
+               $tracep= "extendsplits pass=$pass ".pnode($node)."/$rightback";
+               if (@{ $node->{"Edges$leftback"} } != 1) {
+                   trace("$tracep >1 left edge");
+                   next;
+               }
+               ($leftedge,$leftthisfar)= @{ $node->{"Edges$leftback"}[0] };
+               $leftthatfar= 1-$leftthisfar;
+               $fixedseg= $leftedge->{SubSegSpec};
+               @any_wrong= ();
+               for $rightedgethisfar (@{ $node->{"Edges$rightback"} }) {
+                   ($rightedge,$rightthisfar) = @$rightedgethisfar;
+                   if ($rightedge->{SubSegSpec} !~ m,^(\-?\w+)/\w+$,) {
+                       @any_wrong= ($rightedge, $leftback, "not moveable");
+                   } elsif ($1 ne $fixedseg) {
+                       @any_wrong= ($rightedge, $leftback, "other segment");
+                   }
+                   last if @any_wrong;
+               }
+               if (@any_wrong) {
+                   trace("$tracep $any_wrong[2] ".
+                         pedge($any_wrong[0])."::$any_wrong[1]");
+                   next;
+               }
+               $any_found++;
+               $dist= $leftedge->{Dist};
+               ($leftnode,$leftnoderightback)=
+                   @{ $leftedge->{"Node$leftthatfar"} };
+               deleteedge($leftedge);
+               for $rightedgethisfar (@{ $node->{"Edges$rightback"} }) {
+                   ($rightedge,$rightthisfar) = @$rightedgethisfar;
+                   replumbedge($rightedge,$rightthisfar,
+                               $leftnode,$leftnoderightback);
+                   
+
+                   $rightedge->{Dist} += $leftedge->{Dist};
+                   $rightedge->{"Node$rightthisfar"}=
+               
+               $leftnode->{"Edges$leftnoderightback"} =
+                   [ grep {
+                       ($grepnode, $grepback) = @$_;
+                       !($grepnode == $node &&
+                         $grepback == $leftnoderightback);
+                   }
+                    @{ $leftnode->{"Edges$leftnoderightback"} }
+                    ];
+                       
+                   
+
+    }
+    
+
 sub elimtrivial () {
-    my (@nodeentries); # $nodeentries[$nodenum][$back] = count
     # eliminate trivial nodes: ones which have only two edges, which
-    # come in on opposite sides
+    # come in on opposite sides, and have the same subsegspec
+    
     for $lk (@links) {
        $nodeentries[$lk->[0]][$lk->[1]]++;
        $nodeentries[$lk->[1]][$lk->[2]]++;
@@ -164,6 +240,7 @@ sub elimtrivial () {
 }
 
 readin();
+splitcontin();
 elimtrivial();