Railway circuit

Railway circuit is a draft programming task. It is not yet considered ready to be promoted as a complete task, for reasons that should be found in its talk page.

Railway circuit

Given n sections of curve tracks, each one being an arc of 30° of radius R, the goal is to build and count all possible different railway circuits.

Constraints :

• n = 12 + k*4 (k = 0, 1 , ...)
• The circuit must be a closed, connected graph, and the last arc must joint the first one
• Duplicates, either by symmetry, translation, reflexion or rotation must be eliminated.
• Paths may overlap or cross each other.
• All tracks must be used.

Illustrations : http://www.echolalie.org/echolisp/duplo.html

Task:

Write a function which counts and displays all possible circuits Cn for n = 12, 16 , 20. Extra credit for n = 24, 28, ... 48 (no display, only counts). A circuit Cn will be displayed as a list, or sequence of n Right=1/Left=-1 turns.

Example:

C12 = (1,1,1,1,1,1,1,1,1,1,1,1) or C12 = (-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1)

Straight tracks (extra-extra credit)

Suppose we have m = k*2 sections of straight tracks, each of length L. Such a circuit is denoted Cn,m . A circuit is a sequence of +1,-1, or 0 = straight move. Count the number of circuits Cn,m with n same as above and m = 2 to 8 .

EchoLisp

<lang scheme>

R is turn counter in right direction

The nb of right turns in direction i

must be = to nb of right turns in direction i+6 (opposite)

(define (legal? R) (for ((i 6)) #:break (!= (vector-ref R i) (vector-ref R (+ i 6))) => #f #t))

equal circuits by rotation ?

(define (circuit-eq? Ca Cb) (for [(i (vector-length Cb))] #:break (eqv? Ca (vector-rotate! Cb 1)) => #t #f))

check a result vector RV of circuits

Remove equivalent circuits

(define (check-circuits RV) (define n (vector-length RV)) (for ((i (1- n))) #:continue (null? (vector-ref RV i)) (for ((j (in-range (1+ i) n ))) #:continue (null? (vector-ref RV j)) (when (circuit-eq? (vector-ref RV i) (vector-ref RV j)) (vector-set! RV j null)))))

global

*circuits* = result set = a vector

(define-values (*count* *calls* *circuits*) (values 0 0 null))

generation of circuit C[i] i = 0 .... maxn including straight (may be 0) tracks

(define (circuits C Rct R D n maxn straight ) (define _Rct Rct) ;; save area (define _Rn (vector-ref R Rct)) (++ *calls* )

(cond

   [(> *calls* 4_000_000) #f] ;; enough for maxn=24
   
   ;; hit !! legal solution
   [(and (= n maxn) ( zero? Rct ) (legal? R) (legal? D))

(++ *count*) (vector-push *circuits* (vector-dup C))];; save solution

    ;; stop
    [( = n maxn) #f]

    ;; important cutter - not enough right turns
    [(and (!zero? Rct) (< (+ Rct maxn ) (+ n straight 11))) #f] 

    [else

;; play right (vector+= R Rct 1) ; R[Rct] += 1 (set! Rct (modulo (1+ Rct) 12)) (vector-set! C n 1) (circuits C Rct R D (1+ n) maxn straight)

;; unplay it - restore values (set! Rct _Rct) (vector-set! R Rct _Rn) (vector-set! C n '-)

;; play left (set! Rct (modulo (1- Rct) 12)) (vector-set! C n -1) (circuits C Rct R D (1+ n) maxn straight)

;; unplay (set! Rct _Rct) (vector-set! R Rct _Rn) (vector-set! C n '-)

;; play straight line (when (!zero? straight) (vector-set! C n 0) (vector+= D Rct 1) (circuits C Rct R D (1+ n) maxn (1- straight))

;; unplay (vector+= D Rct -1) (vector-set! C n '-)) ]))

generate maxn tracks [ + straight])

i ( 0 .. 11) * 30° are the possible directions

(define (gen (maxn 20) (straight 0)) (define R (make-vector 12)) ;; count number of right turns in direction i (define D (make-vector 12)) ;; count number of straight tracks in direction i (define C (make-vector (+ maxn straight) '-)) (set!-values (*count* *calls* *circuits*) (values 0 0 (make-vector 0))) (vector-set! R 0 1) ;; play starter (always right) (vector-set! C 0 1) (circuits C 1 R D 1 (+ maxn straight) straight) (writeln 'gen-counters (cons *calls* *count*))

(check-circuits *circuits*) (set! *circuits* (for/vector ((c *circuits*)) #:continue (null? c) c)) (if (zero? straight) (printf "Number of circuits C%d : %d" maxn (vector-length *circuits*)) (printf "Number of circuits C%d,%d : %d" maxn straight (vector-length *circuits*))) (when (< (vector-length *circuits*) 20) (for-each writeln *circuits*))) </lang>

Output:

(gen 12)
gen-counters     (331 . 1)    
Number of circuits C12 : 1
#( 1 1 1 1 1 1 1 1 1 1 1 1)    

(gen 16)
gen-counters     (8175 . 6)    
Number of circuits C16 : 1
#( 1 1 1 1 1 1 -1 1 1 1 1 1 1 1 -1 1)  
  
(gen 20)
gen-counters     (150311 . 39)    
Number of circuits C20 : 6
#( 1 1 1 1 1 1 -1 1 -1 1 1 1 1 1 1 1 -1 1 -1 1)    
#( 1 1 1 1 1 1 -1 -1 1 1 1 1 1 1 1 1 -1 -1 1 1)    
#( 1 1 1 1 1 1 -1 -1 1 1 1 1 1 1 1 -1 1 1 -1 1)    
#( 1 1 1 1 1 -1 1 1 -1 1 1 1 1 1 1 -1 1 1 -1 1)    
#( 1 1 1 1 -1 1 1 1 -1 1 1 1 1 1 -1 1 1 1 -1 1)    
#( 1 1 1 -1 1 1 1 1 -1 1 1 1 1 -1 1 1 1 1 -1 1)  
  
(gen 24)
gen-counters     (2574175 . 286)    
Number of circuits C24 : 35

(gen 12 4)  
Number of circuits C12,4 : 4
#( 1 1 1 1 1 1 0 0 1 1 1 1 1 1 0 0)    
#( 1 1 1 1 1 0 1 0 1 1 1 1 1 0 1 0)    
#( 1 1 1 1 0 1 1 0 1 1 1 1 0 1 1 0)    
#( 1 1 1 0 1 1 1 0 1 1 1 0 1 1 1 0)    

zkl

Translation of: EchoLisp

<lang zkl> // R is turn counter in right direction

   // The nb of right turns in direction i
   // must be = to nb of right turns in direction i+6 (opposite)

fcn legal(R){

  foreach i in (6){ if(R[i]!=R[i+6]) return(False) }
  True

}

   // equal circuits by rotation ?

fcn circuit_eq(Ca,Cb){

  foreach i in (Cb.len()){ if(Ca==Cb.append(Cb.pop(0))) return(True) }
  False

}

   // check a result vector RV of circuits
   // Remove equivalent circuits

fcn check_circuits(RV){ // modifies RV

  n:=RV.len();
  foreach i in (n - 1){
     if(not RV[i]) continue;
     foreach j in ([i+1..n-1]){
        if(not RV[j]) continue;
        if(circuit_eq(RV[i],RV[j])) RV[j]=Void;
     }
  }
  RV

}

   // global variables
   // *circuits* = result set = a vector

var _count, _calls, _circuits;

  // generation of circuit C[i] i = 0 .... maxn including straight (may be 0) tracks

fcn circuits([List]C,[Int]Rct,[List]R,[List]D,n,maxn, straight){

  _Rct,_Rn:=Rct,R[Rct];	// save area
  _calls+=1;

  if(_calls>0d4_000_000) False;	// enough for maxn=24
  else if(n==maxn and 0==Rct and legal(R) and legal(D)){ // hit legal solution
      _count+=1;
      _circuits.append(C.copy());	// save solution
  }else if(n==maxn) False;	// stop

// important cutter - not enough right turns

  else if(Rct and ((Rct + maxn) < (n + straight + 11))) False
  else{
     // play right
     R[Rct]+=1;   Rct=(Rct+1)%12;   C[n]=1;
     circuits(C,Rct,R,D,n+1, maxn, straight);

     Rct=_Rct;   R[Rct]=_Rn;   C[n]=Void;   // unplay it - restore values

     // play left
     Rct=(Rct - 1 + 12)%12;   C[n]=-1;   // -1%12 --> 11 in EchoLisp
     circuits(C,Rct,R,D,n+1,maxn,straight);

     Rct=_Rct;   R[Rct]=_Rn;   C[n]=Void;      // unplay

     if(straight){      // play straight line 

C[n]=0; D[Rct]+=1; circuits(C,Rct,R,D,n+1,maxn,straight-1); D[Rct]+=-1; C[n]=Void; // unplay

     }
  }

}

   // (generate max-tracks  [ + max-straight])

fcn gen(maxn=20,straight=0){

  R,D:=(12).pump(List(),0), R.copy();  // vectors of zero
  C:=(maxn + straight).pump(List(),Void.noop);	// vector of Void
  _count,_calls,_circuits = 0,0,List();
  R[0]=C[0]=1;				// play starter (always right)
  circuits(C,1,R,D,1,maxn + straight,straight);
  println("gen-counters %,d . %d".fmt(_calls,_count));

  _circuits=check_circuits(_circuits).filter();
  if(0==straight)
       println("Number of circuits C%,d : %d".fmt(maxn,_circuits.len()));
  else println("Number of circuits C%,d,%d : %d".fmt(maxn,straight,_circuits.len()));
  if(_circuits.len()<20) _circuits.apply2(T(T("toString",*),"println"));

}</lang> <lang zkl>gen(12); println(); gen(16); println(); gen(20); println(); gen(24); println(); gen(12,4);</lang>

Output:

gen-counters 331 . 1
Number of circuits C12 : 1
L(1,1,1,1,1,1,1,1,1,1,1,1)

gen-counters 8,175 . 6
Number of circuits C16 : 1
L(1,1,1,1,1,1,-1,1,1,1,1,1,1,1,-1,1)

gen-counters 150,311 . 39
Number of circuits C20 : 6
L(1,1,1,1,1,1,-1,1,-1,1,1,1,1,1,1,1,-1,1,-1,1)
L(1,1,1,1,1,1,-1,-1,1,1,1,1,1,1,1,1,-1,-1,1,1)
L(1,1,1,1,1,1,-1,-1,1,1,1,1,1,1,1,-1,1,1,-1,1)
L(1,1,1,1,1,-1,1,1,-1,1,1,1,1,1,1,-1,1,1,-1,1)
L(1,1,1,1,-1,1,1,1,-1,1,1,1,1,1,-1,1,1,1,-1,1)
L(1,1,1,-1,1,1,1,1,-1,1,1,1,1,-1,1,1,1,1,-1,1)

gen-counters 2,574,175 . 286
Number of circuits C24 : 35

gen-counters 375,211 . 21
Number of circuits C12,4 : 4
L(1,1,1,1,1,1,0,0,1,1,1,1,1,1,0,0)
L(1,1,1,1,1,0,1,0,1,1,1,1,1,0,1,0)
L(1,1,1,1,0,1,1,0,1,1,1,1,0,1,1,0)
L(1,1,1,0,1,1,1,0,1,1,1,0,1,1,1,0)