From: ian <ian>
Date: Sun, 25 Jan 2004 19:21:02 +0000 (+0000)
Subject: selecting solutions
X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~ijackson/git?a=commitdiff_plain;h=2761994eab782886dd07a356ac65f6db73724edd;p=trains.git

selecting solutions
---

diff --git a/layout/informat.txt b/layout/informat.txt
index bcdd50b..a47dee5 100644
--- a/layout/informat.txt
+++ b/layout/informat.txt
@@ -35,13 +35,21 @@ Commands
   If length R specified, draws an arc of radius R; R +ve curves to the
   right; R -ve to the left.
 
- join F T arcs               two circular arcs of equal minimised radius
- join F T arcsline R         straight line between two arcs radius R
- join F T arcline            straight line and arc of minimised radius
+ join F T R [S ...]
   Joins one existing loc, F, to another, T.  F's direction points to
   the new track; T's away - ie the added track leaves F in F's
-  direction and arrives at T in T's direction.  In each case solution
-  is chosen with minimum total added length.
+  direction and arrives at T in T's direction.  R is the minimum curve
+  radius allowed.  S selects from the available solutions, and may be
+  any of the following
+     long                  prefer longer length solution
+     short                 prefer shorter length solution
+     right|left            prefer mostly bending to the left resp. right
+     beginright|beginleft  prefer first bend to the right
+     endright|endleft      prefer final bend to the right
+     [!]twoarcs            prefer [not] two circular arcs of equal radius
+     [!]arcline            prefer [not] one line and an arc of max radius
+     [!]arcsline           prefer [not] line between two arcs of min radius
+  if this doesn't resolve, will pick the shortest.
 
  defobj O
  [commands]
diff --git a/layout/layout b/layout/layout
index 8de5cd5..1f8d4ef 100755
--- a/layout/layout
+++ b/layout/layout
@@ -410,16 +410,13 @@ sub arc ($$$$$) {
 }
 
 sub cmd_join {
-    my ($from,$to,$how,$radius);
+    my ($from,$to,$how,$minradius);
     $from= can(\&cva_idex);
     $to= can(\&cva_idex);
-    $how= can(cvam_enum(qw(arcs arcsline arcline)));
-    if ($how eq 'arcsline') {
-	$radius= can(\&cva_len);
-    }
-    my (@paths);
-    if ($how eq 'arcs') {
-	my ($sigma,$distfact, $theta,$phi, $a,$b,$c,$d, $m,$r);
+    $minradius= can(\&cva_len);
+    my (@paths,@solkinds);
+    do {
+	my ($sigma,$distfact, $theta,$phi, $a,$b,$c,$d, $m,$r, $radius);
 	my ($cvec,$cfrom,$cto,$midpt, $delta1,$delta2, $path,$reverse);
 	$sigma= ev_bearing($from,$to);
 	$distfact= v_dist($from,$to);
@@ -430,8 +427,10 @@ sub cmd_join {
 	$c= -1;
 	$d= sqrt($b*$b - 4*$a*$c);
 	foreach $m (qw(-1 1)) {
+	    next if $a < 1e-6;
 	    $r= -0.5 * (-$b + $m*$d) / $a;
 	    $radius= -$r * $distfact;
+	    next if abs($radius) < $minradius;
 	    $cfrom=  ev_compose({}, $from, { X=>0, Y=>-$radius, A=>-0.5*$pi });
 	    $cto=    ev_compose({}, $to,   { X=>0, Y=> $radius, A=> 0.5*$pi });
 	    $midpt=  ev_lincomb({}, $cfrom, $cto, 0.5);
@@ -450,29 +449,54 @@ sub cmd_join {
 	    $path= [{ T=>Arc, F=>$from, C=>$cfrom, R=> $radius, D=>$delta1 },
 		    { T=>Arc, F=>$to,   C=>$cto,   R=>-$radius, D=>$delta2 }];
 	    push @paths, $path;
+	    push @solkinds, 'twoarcs';
 	}
-    }
-    my ($path,$segment,$bestpath,$len,$bestlen);
+    } while 0;
+    my ($path,$segment,$bestpath,$len,$scores,$bestscores,@bends,$sk);
+    my ($crit,$cs,$i,$cmp);
     foreach $path (@paths) {
-	o("%   possible path $path\n");
+	$sk= shift @solkinds;
+	o("%   possible path $sk $path\n");
 	$len= 0;
+	@bends= ();
 	foreach $segment (@$path) {
 	    if ($segment->{T} eq Arc) {
 		o("%     Arc C ".loc2dbg($segment->{C}).
 		  " R $segment->{R} D ".ang2deg($segment->{D})."\n");
-		$len += abs($radius * $segment->{D});
+		$len += abs($segment->{R} * $segment->{D});
+		push @bends, signum($segment->{R} * $segment->{D}); # right +ve
 	    } else {
 		die "unknown segment $segment->{T}";
 	    }
 	}
-	o("%   length $len\n");
-	if (!defined($bestpath) || $len < $bestlen) {
-	    $bestpath= $path;
-	    $bestlen= $len;
+	o("%    length $len\n");
+	$scores= [];
+	foreach $crit (@al, 'short') {
+	    if ($crit eq 'long') { $cs= $len; }
+	    elsif ($crit eq 'short') { $cs= -$len; }
+	    elsif ($crit =~ m/^(begin|end|)(left|right)$/) {
+		if ($1 eq 'begin') { $cs= $bends[0]; }
+		elsif ($1 eq 'end') { $cs= $bends[$#bends]; }
+		else { $cs=0; map { $cs += $_ } @bends; }
+		$cs= -$cs if $2 eq 'left';
+	    } elsif ($crit =~ m/^(\!?)(twoarcs|arcline|arcsline)$/) {
+		$cs= ($2 eq $sk) != ($1 eq '!');
+	    }
+	    push @$scores, $cs;
+	}
+	o("%    scores @$scores\n");
+	if (defined $bestpath) {
+	    for ($i=0,$cmp=0; !$cmp && $i<@$scores; $i++) {
+		$cmp= $scores->[$i] <=> $bestscores->[$i];
+	    }
+	    next if $cmp < 0;
 	}
+	$bestpath= $path;
+	$bestscores= $scores;
     }
-    die unless defined $bestpath;
-    o("%   chose path $bestpath\n");
+    die "no solution" unless defined $bestpath;
+    o("%   chose path $bestpath @al\n");
+    @al= ();
     foreach $segment (@$bestpath) {
 	if ($segment->{T} eq 'Arc') {
 	    arc({}, $segment->{C},$segment->{F},$segment->{R},$segment->{D});
diff --git a/layout/testjoin.m4 b/layout/testjoin.m4
index edbd451..71b3843 100644
--- a/layout/testjoin.m4
+++ b/layout/testjoin.m4
@@ -1,6 +1,10 @@
+#!/usr/bin/m4 -Dchoice=
+
+dnl run with -Dchoice='...'
+
 define(`simple',`
 rel b$2 b$2x$1 0 0 $1
-join a$2 -b$2x$1 arcs
+join a$2 -b$2x$1 0 choice
 ')
 
 define(`complex',`
@@ -12,6 +16,7 @@ simple(30,$1)
 simple(60,$1)
 simple(90,$1)
 simple(135,$1)
+simple(230,$1)
 simple(300,$1)
 simple(345,$1)
 ')
@@ -19,5 +24,5 @@ simple(345,$1)
 complex(0,    200,300,  0   )
 complex(30,   200,800,  30  )
 complex(60,   200,1400, 60  )
-complex(m75,  800,500,  -75 )
-complex(m300, 800,1300, -300)
+complex(m130,     1000,500,  -130 )
+complex(m165, 1000,1500, -165)