From: ian <ian>
Date: Sun, 13 Mar 2005 18:03:56 +0000 (+0000)
Subject: wip; working on elimtrivial; considering graph manip in C instead
X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ijackson/git?a=commitdiff_plain;h=fd3c99ee3bb1d7c575c7f9ce257a6bc82d2b9923;p=trains.git

wip; working on elimtrivial; considering graph manip in C instead
---

diff --git a/layout/extractgraph b/layout/extractgraph
index 59981ec..c4399a8 100755
--- a/layout/extractgraph
+++ b/layout/extractgraph
@@ -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();