;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;                                                                        ;;
;;  http://www.research.att.com/~njas/sequences/juggling.scm.txt          ;;
;;                                                                        ;;
;;  Coded by Antti Karttunen (Antti.Karttunen(-AT-)iki.fi), 2003          ;;
;;                                                                        ;;
;;  This file contains the Scheme-functions that compute the sequences    ;;
;;  A084449-A084470, A084489-A084530, A084555-A084557 submitted to        ;;
;;  Neil Sloane's On-Line Encyclopedia of Integer Sequences (OEIS)        ;;
;;  and available at http://www.research.att.com/~njas/sequences/         ;;
;;                                                                        ;;
;;  Copy of THIS source file is also available at:                        ;;
;;  http://www.iki.fi/~karttu/matikka/Schemuli/juggling.scm               ;;
;;                                                                        ;;
;;  This Scheme-code is in Public Domain and runs (at least)              ;;
;;  in MIT Scheme Release 7.7.x, for which one can find documentation     ;;
;;  and the pre-compiled binaries (for various OS's running in            ;;
;;  Intel x86 architecture) under the URL:                                ;;
;;  http://www.swiss.ai.mit.edu/projects/scheme/                          ;;
;;                                                                        ;;
;;  This should be a stand-alone module.                                  ;;
;;                                                                        ;;
;;  Note that "Polster's book" mentioned here refers to:                  ;;
;;  Burkard Polster, The Mathematics of Juggling, Springer-Verlag, 2003.  ;;
;;                                                                        ;;
;;  Please feel free to add more code here, if you want to compute        ;;
;;  the corresponding sequences for 2, 4 and 5 balls for example.         ;;
;;  Send the edited version then either to my address                     ;;
;;  (with subject "TOPIC: Juggling.scm.txt")                              ;;
;;  or Neil's address at njas(-AT-)research.att.com,                      ;;
;;  so that the attachment                                                ;;
;;    http://www.research.att.com/~njas/sequences/juggling.scm.txt        ;;
;;  stays up-to-date.                                                     ;;
;;                                                                        ;;
;;  Last edited 2. June 2003 by Antti Karttunen.                          ;;
;;                                                                        ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


;;
;; In my system I have this located as C:\matikka\Schemuli\juggling.scm
;; so I can either load this as:
;; (load "c:\\matikka\\Schemuli\\juggling.scm")
;;
;; or compile as:
;; (cf "c:\\matikka\\Schemuli\\juggling.scm" "c:\\matikka\\Schemuli\\")
;; and then load the compiled image as:
;; (load "c:\\matikka\\Schemuli\\juggling.com")
;;
;; 


(declare (usual-integrations))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;                                                                         ;;
;;  Copied from http://www.iki.fi/~kartturi/matikka/Schemuli/definech.scm  ;;
;;                                                                         ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


;; define unary cached functions. Syntax is like
;; (define (func arg) ...) of Scheme.

;; Note that this and other cached functions depend on MIT Scheme
;; peculiarities, like that vectors are initialized to contain #f's
;; and also that #f is actually same thing as (). To be corrected.

;; Added this 10. July 2002 to avoid allocation catastrophes
;; caused by the careless use of the cached integer functions:
(define *MAX-CACHE-SIZE-FOR-DEFINEC* 290512) ;; Was 131072


(define-syntax definec
  (syntax-rules ()
   ((definec (name arg) e0 ...)
      (define name
        (letrec
           ((_cache_ (vector #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f))
            (name
             (lambda (arg)
               (cond ((null? arg) _cache_)
                     ((>= arg *MAX-CACHE-SIZE-FOR-DEFINEC*)
                          e0 ...
                     )
                     (else
                         (if (>= arg (vector-length _cache_))
                             (set! _cache_
                                   (vector-grow
                                           _cache_
                                           (min *MAX-CACHE-SIZE-FOR-DEFINEC*
                                                (max (1+ arg)
                                                     (* 2 (vector-length _cache_))
                                                )
                                           )
                                   )
                             )
                         )
                         (or (vector-ref _cache_ arg)
                             ((lambda (res)
                                (vector-set! _cache_ arg res)
                                res
                              )
                               (begin e0 ...)
                             )
                         )
                     )
               ) ; cond
             )
            )
           ) ; letrec-definitions
          name
        ) ; letrec
      ) ;; (define name ...)
   )
  ) ;; syntax-rules
)


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;                                                                         ;;
;;  Copied from http://www.iki.fi/~kartturi/matikka/Schemuli/lstfuns1.scm  ;;
;;  (always useful!)                                                       ;;
;;                                                                         ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


(define (compose-funs . funlist)
 (cond ((null? funlist) (lambda (x) x))
       (else (lambda (x) ((car funlist) ((apply compose-funs (cdr funlist)) x))))
 )
)

(define reversed_iota
  (lambda (n)
      (if (zero? n) (list)
          (cons n (reversed_iota (- n 1)))
      )
  )
)

(define iota (lambda (n) (reverse! (reversed_iota n))))

(define (iota0 upto_n)
   (let loop ((n upto_n) (result (list)))
      (cond ((zero? n) (cons 0 result))
            (else (loop (- n 1) (cons n result)))
      )
   )
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;                                                                         ;;
;;  Copied from http://www.iki.fi/~kartturi/matikka/Schemuli/intfuns1.scm  ;;
;;                                                                         ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


(define (first_pos_with_funs_val_gte fun n)
   (let loop ((i 0))
      (if (>= (fun i) n) i
          (loop (1+ i))
      )
   )
)

(definec (binomial_n_2 n) (/ (* (-1+ n) n) 2))

;; At some point these will produce incorrect values, because of the
;; limited precision of IEEE 64-bit floating point numbers.
;; What is that point, and how to recode these with strictly fixnum-only
;; way? (I need a fixnum-only square root algorithm...)
(definec (A025581 n) ;; The X component (column) of square {0..inf} arrays
  (- (binomial_n_2 (1+ (floor->exact (flo:+ 0.5 (flo:sqrt (exact->inexact (* 2 (1+ n)))))))) (1+ n))
)

;; (map A002262 (cons 0 (iota 20))) --> (0 0 1 0 1 2 0 1 2 3 0 1 2 3 4 0 1 2 3 4 5)
(definec (A002262 n) ;; The Y component (row) of square {0..inf} arrays
  (- n (binomial_n_2 (floor->exact (flo:+ 0.5 (flo:sqrt (exact->inexact (* 2 (1+ n))))))))
)


(define (A002024 n) ;; repeat n n times, starting from n = 1.
  (floor->exact (+ (/ 1 2) (sqrt (* 2 n))))
)

(define (A003056 n) ;; repeat n n+1 times, starting from n = 0.
  (floor->exact (- (sqrt (* 2 (1+ n))) (/ 1 2)))
)

(define (A000265 n) (/ n (A006519 n))) ;; Remove 2s from n; or largest odd divisor of n.

(define (A006519 n) ;; Highest power of 2 dividing n: 1,2,1,4,1,2,1,8,1,2,1,4,1,2,1,16
   (cond ((zero? n) 0)
         (else (let loop ((n n) (i 1))
                 (cond ((odd? n) i)
                       (else (loop (floor->exact (/ n 2)) (* i 2)))
                 )
               )
         )
   )
)


;; Note that (A007814 33574912) = 12.
(define (A007814 n) ;; Exponent of the A006519.
   (cond ((zero? n) 0)
         (else (let loop ((n n) (i 0))
                 (cond ((odd? n) i)
;;                     (else (loop (fix:lsh n -1) (1+ i))) ;; Dangerous code.
                       (else (loop (floor->exact (/ n 2)) (1+ i)))
                 )
               )
         )
   )
)


(define (A007088 n) ;; 0,1,10,11,100,101,110,111,1000,... (Show binary form in decimal)
  (let loop ((z 0) (i 0) (n n))
    (if (zero? n)
        z
        (loop (+ z (* (expt 10 i) (modulo n 2)))
              (1+ i)
              (floor->exact (/ n 2))
        )
    )
  )
)


;; One-based:
(define (A018900 n) (+ (expt 2 (A002024 n)) (expt 2 (A002262 (-1+ n)))))



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;                                                                         ;;
;;  Some asynchronic, infinite juggling sequences, with the states and     ;;
;;  throw-heights (i.e. usual "siteswap"-notation).                        ;;
;;                                                                         ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define (N2Z n) (* (expt -1 n) (floor->exact (/ n 2))))
(define (Z2n z) (+ (* 2 (abs z)) (if (not (positive? z)) 1 0)))
;; (Note that zero is not a positive number.)

;; (map N2Z (iota 30))
;; (0 1 -1 2 -2 3 -3 4 -4 5 -5 6 -6 7 -7 8 -8 9 -9 10 -10 11 -11 12 -12 13 -13 14 -14 15)
;; Essentially A001057, but using offset=1 instead of 0.

;; These six are one-based:
(define A065164 (compose-funs Z2N 1+ N2Z))
(define A065165 (compose-funs Z2N 1+ 1+ N2Z))
(define A065166 (compose-funs Z2N 1+ 1+ 1+ N2Z))
(define A065168 (compose-funs Z2N -1+ N2Z))
(define A065169 (compose-funs Z2N -1+ -1+ N2Z))
(define A065170 (compose-funs Z2N -1+ -1+ -1+ N2Z))

;; E.g.:
;; (map A065166 (iota 20)) --> (6 8 4 10 2 12 1 14 3 16 5 18 7 20 9 22 11 24 13 26)
;; (map A065170 (iota 20)) --> (7 5 9 3 11 1 13 2 15 4 17 6 19 8 21 10 23 12 25 14)

(define (reflect-to-Z throw-fun z)
   (cond ((zero? z) z) ;; Do a zero-throw at beat 0.
         ((positive? z) (throw-fun z))
         (else ;; Beats before zero...
            (let loop ((i (- z)))
               (cond ((zero? i) (* 2 (- z)))
                     ((= (+ i (throw-fun i)) (- z)) (- (- z) i))
                     (else (loop (-1+ i)))
               )
            ) 
         )
   )
)


;; Applying the idea of "Inverse of Juggling Sequence"
;; (See Polster's book, pages 25-27) to infinite permutations:
;; (This one for 3-ball sequences.)
(define (reflect-to-Z-b3 throw-fun permfun z)
   (cond ((positive? z) (throw-fun z))
         ((<= (- z) 3) (* 2 (- z)))
         (else (throw-fun (permfun (- (- z) 3))))
   )
)


;; 84449 --- 84463.

(definec (A084449 n) ;; Positions of sevens (ground states) in A084451.
   (cond ((zero? n) n)
         (else
           (let loop ((i (1+ (A084449 (-1+ n)))))
                 (cond ((= (A084451 0) (A084451 i)) i)
                       (else (loop (1+ i)))
                 )
           )
         )
   )
)

;; First differences of A084449:
(define (A084465 n) (- (A084449 (1+ n)) (A084449 n)))



(define (A084450 n) (A007088 (A084451 n)))

(definec (A084451 n)
   (if (zero? n)
       7 ;; Ground-state for three balls (bits).
       (/ (-1+ (+ (A084451 (-1+ n)) (expt 2 (A084452 n)))) 2)
   )
)


;; (definec (A084451v2 n) ;; Older variant.
;;    (cond ((zero? n) 7) ;; Ground-state for three balls (bits).
;;          (else (+ (floor->exact (/ (A084451v2 (-1+ n)) 2))
;;                   (floor->exact (expt 2 (- (A084452 n) 1)))
;;                )
;;          )
;;    )
;; )
;; 


(define (A084452 n) ;; One-based: 4,4,4,0,5,5,5,0,0,6,3,5,
  (let ((prevstate (A084451 (-1+ n))))
   (cond
     ((even? prevstate) 0) ;; Must throw zero!
     (else
;;     (call-with-current-continuation
;;       (lambda (return)
           (let outloop ((t 1))
             (cond ((even? (floor->exact (/ prevstate (expt 2 t)))) ;; Free position?
                      (let inloop ((c (+ (floor->exact (/ prevstate 2))
                                         (expt 2 (-1+ t))
                                      )
                                   )
                                   (i (-1+ n))
                                  )
                             (cond ((< i 0) t) ;; (return t)
                                   ((= c (A084451 i)) (outloop (1+ t)))
                                   (else (inloop c (-1+ i)))
                             )
                      )
                   )
                   (else (outloop (1+ t)))
             )
           )
;;       )
;;     )
     )
   )
  )
)


(definec (A084453 n) (- (+ n (A084452 n)) 3))
(define (A084454 n) (let loop ((i 1)) (cond ((= n (A084453 i)) i) (else (loop (1+ i))))))

;; Inverse is A084466.
(define A084455 (compose-funs Z2N
                              (lambda (z) (+ z (reflect-to-Z A084452 z)))
                              N2Z
                )
)
(define A084455v2 (compose-funs Z2N
                                (lambda (z) (+ z (reflect-to-Z-b3 A084452 A084454 z)))
                                N2Z
                  )
)

(define (A084466 n) (let loop ((i 1)) (cond ((= n (A084455 i)) i) (else (loop (1+ i))))))


;;;;;;;;;;;;

(define (A084456 n) (A007088 (A084457 n)))


(definec (A084457 n)
   (if (zero? n)
       7 ;; Ground-state for three balls (bits).
       (/ (+ -1 (A084457 (-1+ n)) (expt 2 (A084458 n))) 2)
   )
)

(define (A084458 n) ;; One-based: 4,4,6,0,5,8,0,0,3,7,0,7,0,9,0,0,7,0,10,...
  (let ((prevstate (A084457 (-1+ n))))
   (cond
     ((even? prevstate) 0) ;; Must throw zero!
     (else
       (let outloop ((t 1))
          (cond ((even? (floor->exact (/ prevstate (expt 2 t)))) ;; Free position?
                    (let inloop ((c (A000265 (+ (floor->exact (/ prevstate 2))
                                                (expt 2 (-1+ t))
                                             )
                                    )
                                 )
                                 (i (-1+ n))
                                )
                           (cond ((< i 0) t)
                                 ((= c (A084457 i)) (outloop (1+ t)))
                                 (else (inloop c (-1+ i)))
                           )
                    )
                 )
                 (else (outloop (1+ t)))
          )
       )
     )
   )
  )
)



(define (A084459 n) (- (+ n (A084458 n)) 3))
(define (A084460 n) (let loop ((i 1)) (cond ((= n (A084459 i)) i) (else (loop (1+ i))))))

(define A084461 (compose-funs Z2N
                              (lambda (z) (+ z (reflect-to-Z A084458 z)))
                              N2Z
                )
)
(define A084461v2 (compose-funs Z2N
                                (lambda (z) (+ z (reflect-to-Z-b3 A084458 A084460 z)))
                                N2Z
                  )
)
(define (A084462 n) (let loop ((i 1)) (cond ((= n (A084461 i)) i) (else (loop (1+ i))))))


;; One-based:
(definec (A084463 n) ;; Positions of even states in 84457, i.e. zeros in A084458 - 1.
   (cond ((= 1 n) 3)
         (else
           (let loop ((i (1+ (A084463 (-1+ n)))))
                 (cond ((even? (A084457 i)) i)
                       (else (loop (1+ i)))
                 )
           )
         )
   )
)


;; Positions of odd states in 84457, i.e. non-zero-throws in A084458 - 1. One-based.
(definec (A084464 n)
   (cond ((= 1 n) 0)
         (else
           (let loop ((i (1+ (A084464 (-1+ n)))))
                 (cond ((odd? (A084457 i)) i)
                       (else (loop (1+ i)))
                 )
           )
         )
   )
)


;; One-based:
(definec (A084467 n) (A084457 (A084464 n)))
;; (map A084467 (iota 22))
;; (7 11 13 19 25 35 21 37 41 69 49 67 97 131 73 137 81 133 161 261 193 259)
;; (keep-matching-items (map A084457 (iota0 64)) odd?)
;; (7 11 13 19 25 35 21 37 41 69 49 67 97 131 73 137 81 133 161 261 193 259 145 265 289)

;; One-based:
(definec (A084468 n) (1+ (* 2 (A018900 n))))
;; (map A084468 (iota 22))
;; (7 11 13 19 21 25 35 37 41 49 67 69 73 81 97 131 133 137 145 161 193 259)


(define (A084469 n)
   (let loop ((x (A084467 n)) (i 1))
      (cond ((= x (A084468 i)) i)
            (else (loop x (1+ i)))
      )
   )
)

(define (A084470 n)
   (let loop ((x (A084468 n)) (i 1))
      (cond ((= x (A084467 i)) i)
            (else (loop x (1+ i)))
      )
   )
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;                                                                         ;;
;;  Successively larger loops starting from and returning to the ground    ;;
;;  state (with various conditions).                                       ;;
;;                                                                         ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; This implementation is very straightforward and dumb.
;; It would be more efficient to merge the functions
;; next-test-vector! and gs2gs? together, and not to speak
;; about the fact that there EXISTS an _unranking_ algorithm
;; for type=0 ground-state sequences, except that I'm afraid
;; that we cannot find such a variant that would return
;; the sequences in the ascending lexical order.
;; See Polster's book, pages 28-29, for Martin Probert's
;; "Pick a Pattern Procedure", or:
;; Probert, Martin. Four Ball Juggling. Published by Veronika Probert, U.K., 1995.
;;
;; (Even with that drawback a direct unranking algorithm would be useful
;;  when computing the terms of A084529 for example).
;;

(define (vec-to-dec tv)
   (let loop ((i 0) (s 0))
      (cond ((= (vector-length tv) i) s)
            (else (loop (1+ i) (+ (* 10 s) (vector-ref tv i))))
      )
   )
)


;; tv is a vector, p = (vector-length tv), i = running index, 0 initially.

;; (last-possible? (vector) 2 0 0) -->  #t
;; (last-possible? (vector 3) 3 1 0) -->  #t
;; (last-possible? (vector 3 1) 3 2 0) -->  #t
;; (last-possible? (vector 5 3 1) 5 3 0) -->  #t
;; (last-possible? (vector 6 4 2 0) 6 4 0) -->  #t
;; (last-possible? (vector 7 5 3 1 0) 7 5 0) -->  #t
;; (last-possible? (vector 8 6 4 2 0 0) 8 6 0) -->  #t

(define (last-possible? tv u p i)
   (cond ((= i p) #t)
         ((= (vector-ref tv i) u)
                (last-possible? tv (max (- u 2) 0) p (1+ i))
         )
         (else #f)
   )
)


(define (next-test-vector! tv b) ;; b is the number of balls.
  (let ((p (vector-length tv))) ;; Period of our (sub-)pattern.
     (cond ((last-possible? tv (+ p (-1+ b)) p 0)
               (make-vector (1+ p) b) ;; Return one element longer vector [b,b,b,...,b]
           )
           (else ;; Increment with an odometer-principle, from right to left:
              (let loop ((i (-1+ p)) (u b))
                 (cond ((< i 0)
                             (error "next-test-vector! should not happen: tv=" tv
                                  " i=" i " u=" u " b=" b
                             )
                       )
                       ((= (vector-ref tv i) u) ;; Highest poss. value for this thow?
                             (vector-set! tv i 0)  ;; Replace with a zero throw
                             (loop (-1+ i) (1+ u)) ;; and continue to the left.
                       )
                       (else ;; Found a position with not yet in its max. height.
                             (vector-set! tv i (1+ (vector-ref tv i)))  ;; Increment
                             tv                                         ;; and return.
                       )
                 )
              )
           )
     )
  )
)

;;
;; Above works like this.
;; Alternatively, we could take the multiples of b!,
;; and discard b-1 least significant digits (zeros)
;; from their factorial expansion.
;;
;; (begin (set! v (next-test-vector! (vector) 3)) v) --> #(3)
;; (begin (set! v (next-test-vector! v 3)) v) --> #(3 3)
;; (begin (set! v (next-test-vector! v 3)) v) --> #(4 0)
;; (begin (set! v (next-test-vector! v 3)) v) --> #(4 1)
;; (begin (set! v (next-test-vector! v 3)) v) --> #(4 2)
;; (begin (set! v (next-test-vector! v 3)) v) --> #(3 3 3)
;; (begin (set! v (next-test-vector! v 3)) v) --> #(3 4 0)
;; (begin (set! v (next-test-vector! v 3)) v) --> #(3 4 1)
;; (begin (set! v (next-test-vector! v 3)) v) --> #(3 4 2)
;; (begin (set! v (next-test-vector! v 3)) v) --> #(3 4 3)
;; (begin (set! v (next-test-vector! v 3)) v) --> #(4 0 0)
;; (begin (set! v (next-test-vector! v 3)) v) --> #(4 0 1)
;; (begin (set! v (next-test-vector! v 3)) v) --> #(4 0 2)
;; (begin (set! v (next-test-vector! v 3)) v) --> #(4 0 3)
;; (begin (set! v (next-test-vector! v 3)) v) --> #(4 1 0)
;; (begin (set! v (next-test-vector! v 3)) v) --> #(4 1 1)
;; (begin (set! v (next-test-vector! v 3)) v) --> #(4 1 2)
;; (begin (set! v (next-test-vector! v 3)) v) --> #(4 1 3)
;; (begin (set! v (next-test-vector! v 3)) v) --> #(4 2 0)
;; (begin (set! v (next-test-vector! v 3)) v) --> #(4 2 1)
;; (begin (set! v (next-test-vector! v 3)) v) --> #(4 2 2)
;; (begin (set! v (next-test-vector! v 3)) v) --> #(4 2 3)
;; (begin (set! v (next-test-vector! v 3)) v) --> #(4 3 0)
;; (begin (set! v (next-test-vector! v 3)) v) --> #(4 3 1)
;; (begin (set! v (next-test-vector! v 3)) v) --> #(4 3 2)
;; (begin (set! v (next-test-vector! v 3)) v) --> #(4 3 3)
;; (begin (set! v (next-test-vector! v 3)) v) --> #(4 4 0)
;; (begin (set! v (next-test-vector! v 3)) v) --> #(4 4 1)
;; (begin (set! v (next-test-vector! v 3)) v) --> #(4 4 2)
;; (begin (set! v (next-test-vector! v 3)) v) --> #(4 4 3)
;; (begin (set! v (next-test-vector! v 3)) v) --> #(5 0 0)
;; (begin (set! v (next-test-vector! v 3)) v) --> #(5 0 1)
;; (begin (set! v (next-test-vector! v 3)) v) --> #(5 0 2)
;; (begin (set! v (next-test-vector! v 3)) v) --> #(5 0 3)
;; (begin (set! v (next-test-vector! v 3)) v) --> #(5 1 0)
;; (begin (set! v (next-test-vector! v 3)) v) --> #(5 1 1)
;; (begin (set! v (next-test-vector! v 3)) v) --> #(5 1 2)
;; (begin (set! v (next-test-vector! v 3)) v) --> #(5 1 3)
;; (begin (set! v (next-test-vector! v 3)) v) --> #(5 2 0)
;; (begin (set! v (next-test-vector! v 3)) v) --> #(5 2 1)
;; (begin (set! v (next-test-vector! v 3)) v) --> #(5 2 2)
;; (begin (set! v (next-test-vector! v 3)) v) --> #(5 2 3)
;; (begin (set! v (next-test-vector! v 3)) v) --> #(5 3 0)
;; (begin (set! v (next-test-vector! v 3)) v) --> #(5 3 1)
;; (begin (set! v (next-test-vector! v 3)) v) --> #(3 3 3 3)
;; 

;; type = 0: Anything goes.
;; type = 1: No ground state in the middle allowed.
;; type = 2: No state should be visited twice (i.e. collect only "prime" loops).

;; (gs2gs? (vector 3) 3 0) -->  #t
;; (gs2gs? (vector 3 3) 3 0) -->  #t
;; (gs2gs? (vector 3 3 3) 3 0) -->  #t
;; (gs2gs? (vector 3 3 3) 3 1) -->  ()
;; (gs2gs? (vector 3 3 3) 3 2) -->  ()
;; (gs2gs? (vector 4 2) 3 0) -->  #t
;; (gs2gs? (vector 4 2) 3 1) -->  #t
;; (gs2gs? (vector 4 2) 3 2) -->  #t
;; (gs2gs? (vector 4 2 3) 3 0) -->  #t
;; (gs2gs? (vector 4 2 3) 3 1) -->  ()
;; (gs2gs? (vector 4 2 3) 3 2) -->  ()
;; (gs2gs? (vector 4 4 1) 3 0) -->  #t
;; (gs2gs? (vector 4 4 1) 3 1) -->  #t
;; (gs2gs? (vector 4 4 1) 3 2) -->  #t
;; (gs2gs? (vector 5 3 1) 3 0) -->  #t
;; (gs2gs? (vector 5 3 1) 3 1) -->  #t
;; (gs2gs? (vector 5 3 1) 3 2) -->  #t
;; (gs2gs? (vector 4 5 1 2) 3 0) -->  #t
;; (gs2gs? (vector 4 5 1 2) 3 1) -->  #t
;; (gs2gs? (vector 4 5 1 2) 3 2) -->  ()


(define (gs2gs? tv b type)
  (let ((gs (-1+ (expt 2 b))) ;; The ground state, e.g. 7 for b=3.
        (p (vector-length tv)) ;; Period of our tentative pattern
       )
    (let loop ((s gs) (i 0) (visited (list)))
;; When finished, return true only if we have returned back to the ground state:
       (cond ((= i p) (= s gs))
             (else
               (let ((tt (vector-ref tv i)))
                  (cond ((and (= 1 type) (> i 0) (= s gs)) #f)
                        ((and (= 2 type) (memq s visited)) #f)
                        ((and (even? s) (not (zero? tt))) #f) ;; Zero-throw expected!
                        ((not (even? (floor->exact (/ s (expt 2 tt)))))
                                                          #f  ;; Collision!
                        )
                        (else
                           (loop (floor->exact (/ (+ s (expt 2 tt)) 2))
                                 (1+ i)
                                 (if (= 2 type) (cons s visited) visited)
                           )
                        )
                  )
               )
             )
       ) ;; cond
    ) ;; let loop
  )
)




(definec (nth-successful-test-vector-3-0 n)
   (cond ((zero? n) (vector))
         (else
           (let loop ((tv (next-test-vector!
                            (vector-copy (nth-successful-test-vector-3-0 (-1+ n)))
                            3
                          )
                     ))
              (cond ((gs2gs? tv 3 0) tv)
                    (else (loop (next-test-vector! tv 3)))
              )
           )
         )
   )
)

;; Instead of having zillion simple functions like one above,
;; we now have the complex function-defining function given below,
;; which we can reuse for all the possible variants.
;; E.g. we could define a copy of above function as:
;; (define another-nth-successful-test-vector-3-0
;;   (cacfun-for-nth-successful-test-vec 3 0)
;; )
;;

(define (cacfun-for-nth-successful-test-vec balls type)
 (letrec
   ((_cache_ (vector #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f))
    (belgthor ;; The function we are defining and returning here.
      (lambda (n)
       (cond ((not (integer? n)) _cache_) ;; Just for debugging.
             (else
               (if (>= n (vector-length _cache_))
                   (set! _cache_
                        (vector-grow _cache_
                                     (max (1+ n)
                                          (* 2 (vector-length _cache_))
                                     )
                        )
                   )
               )
               (or (vector-ref _cache_ n)
                   ((lambda (result)
                      (vector-set! _cache_ n result)
                      result
                    )
                     (cond ((zero? n) (vector))
                           (else
                              (let loop ((tv (next-test-vector!
                                               (vector-copy (belgthor (-1+ n)))
                                               balls
                                             )
                                        ))
                                 (cond ((gs2gs? tv balls type) tv)
                                       (else
                                          (loop (next-test-vector! tv balls))
                                       )
                                 )
                              )
                           )
                     )
                   ) ;; Invocation of the lambda-form
               ) ;; or
             ) ;; else
       ) ;; cond
      ) ; lambda (n)
    )
   ) ;; letrec-definitions.
  belgthor
 ) ;; letrec
)



;; What we really should have, is macro that would expand to
;; this, with its invocation's body-part inserted as an argument
;; to that inner lambda-form.
;; I.e. macro with which we could define functions that return
;; lambda-forms (which cache their only argument).

(define (cacfun-for-posfun fun start-from elem)
 (letrec
   ((_cache_ (vector #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f))
    (tvimadur ;; The function we are defining and returning here.
      (lambda (n)
       (cond ((not (integer? n)) _cache_) ;; Just for debugging.
             (else
               (if (>= n (vector-length _cache_))
                   (set! _cache_
                        (vector-grow _cache_
                                     (max (1+ n)
                                          (* 2 (vector-length _cache_))
                                     )
                        )
                   )
               )
               (or (vector-ref _cache_ n)
                   ((lambda (result)
                      (vector-set! _cache_ n result)
                      result
                    )
                     (cond ((= start-from n) n)
                           (else
                             (let loop ((i (if (= start-from n)
                                               n
                                               (1+ (tvimadur (-1+ n)))
                                           )
                                       ))
                                   (cond ((= (fun i) elem) i)
                                         (else (loop (1+ i)))
                                   )
                             )
                           )
                     )
                   ) ;; Invocation of the lambda-form
               ) ;; or
             ) ;; else
       ) ;; cond
      ) ; lambda (n)
    )
   ) ;; letrec-definitions.
  tvimadur
 ) ;; letrec
)



(define nth-successful-test-vec-3-0 (cacfun-for-nth-successful-test-vec 3 0))
(define nth-successful-test-vec-3-1 (cacfun-for-nth-successful-test-vec 3 1))
(define nth-successful-test-vec-3-2 (cacfun-for-nth-successful-test-vec 3 2))


;; 84489 --- 84530 reserved for us.

;; First twelve permutations of non-negative integers & natural numbers
;; induced by these three infinite siteswap-sequences:

;; One-based:
(definec (A084489 n) (- (+ n (A084501 n)) 3))
(define (A084490 n) (let loop ((i 1)) (cond ((= n (A084489 i)) i) (else (loop (1+ i))))))

(define A084491 (compose-funs Z2N
                              (lambda (z) (+ z (reflect-to-Z A084501 z)))
                              N2Z
                )
)
(define A084491v2 (compose-funs Z2N
                                (lambda (z) (+ z (reflect-to-Z-b3 A084501 A084490 z)))
                                N2Z
                  )
)

(define (A084492 n) (let loop ((i 1)) (cond ((= n (A084491 i)) i) (else (loop (1+ i))))))

;;;;;;;;;;;;;

(definec (A084493 n) (- (+ n (A084511 n)) 3))
(define (A084494 n) (let loop ((i 1)) (cond ((= n (A084493 i)) i) (else (loop (1+ i))))))

(define A084495 (compose-funs Z2N
                              (lambda (z) (+ z (reflect-to-Z A084511 z)))
                              N2Z
                )
)
(define A084495v2 (compose-funs Z2N
                                (lambda (z) (+ z (reflect-to-Z-b3 A084511 A084494 z)))
                                N2Z
                  )
)

(define (A084496 n) (let loop ((i 1)) (cond ((= n (A084495 i)) i) (else (loop (1+ i))))))

;;;;;;;;;;;;;

(definec (A084497 n) (- (+ n (A084521 n)) 3))
(define (A084498 n) (let loop ((i 1)) (cond ((= n (A084497 i)) i) (else (loop (1+ i))))))

(define A084499 (compose-funs Z2N
                              (lambda (z) (+ z (reflect-to-Z A084521 z)))
                              N2Z
                )
)
(define A084499v2 (compose-funs Z2N
                                (lambda (z) (+ z (reflect-to-Z-b3 A084521 A084498 z)))
                                N2Z
                  )
)

(define (A084530 n) (let loop ((i 1)) (cond ((= n (A084499 i)) i) (else (loop (1+ i))))))


;; Siteswap-sequences (throws):                   A084501, A084511, A084521
;; Siteswap-sequences (finite decimal notation):  A084502, A084512, A084522
;; Associated state-sequences (decimal notation): A084503, A084513, A084523
;; Associated state-sequences (binary notation):  A084504, A084514, A084524
;; partial sums of the next:                      A084505, A084515, A084525
;; length of each gs->gs siteswap-subpattern, ~first diff of above        -6
;; first position of n in A0845[0-2]1:                                    -7
;; positions of 1's in that.                                              -8
;; their first differences (~ count of how many siteswaps of each period) -9

;; All are one-based, except the state-sequences, or unless otherwise noted.

;; These tell at which siteswap sub-pattern (as given by A0845{0,1,2}2)
;; is the nth term of A0845{0-2}1:

(definec (A084500 n) (first_pos_with_funs_val_gte A084505 n))
(definec (A084510 n) (first_pos_with_funs_val_gte A084515 n))
(definec (A084520 n) (first_pos_with_funs_val_gte A084525 n))

;; (equal? (map A084510 (iota 64)) (map A084520 (iota 64))) --> #t
;; (A084510 65) --> 19
;; (A084520 65) --> 18

(definec (A084501 n)
   (vector-ref (nth-successful-test-vec-3-0 (A084500 n))
               (- n (1+ (A084505 (-1+ (A084500 n)))))
   )
)

(definec (A084511 n)
   (vector-ref (nth-successful-test-vec-3-1 (A084510 n))
               (- n (1+ (A084515 (-1+ (A084510 n)))))
   )
)

(definec (A084521 n)
   (vector-ref (nth-successful-test-vec-3-2 (A084520 n))
               (- n (1+ (A084525 (-1+ (A084520 n)))))
   )
)




;; Siteswap-sequences (finite decimal notation):  A084502, A084512, A084522
(define A084502 (compose-funs vec-to-dec nth-successful-test-vec-3-0))
(define A084512 (compose-funs vec-to-dec nth-successful-test-vec-3-1))
(define A084522 (compose-funs vec-to-dec nth-successful-test-vec-3-2))

;; These are zero-based:
(definec (A084503 n)
   (cond ((zero? n) (-1+ (expt 2 3))) ;; 7 = ground-state for three balls (bits).
         (else (/ (+ -1 (A084503 (-1+ n)) (expt 2 (A084501 n))) 2))
   )
)

(definec (A084513 n)
   (cond ((zero? n) (-1+ (expt 2 3))) ;; 7 = ground-state for three balls (bits).
         (else (/ (+ -1 (A084513 (-1+ n)) (expt 2 (A084511 n))) 2))
   )
)

(definec (A084523 n)
   (cond ((zero? n) (-1+ (expt 2 3))) ;; 7 = ground-state for three balls (bits).
         (else (/ (+ -1 (A084523 (-1+ n)) (expt 2 (A084521 n))) 2))
   )
)

;; As well:
(define A084504 (compose-funs A007088 A084503))
(define A084514 (compose-funs A007088 A084513))
(define A084524 (compose-funs A007088 A084523))

;; Partial sums of the next ones, zero-based.
(definec (A084505 n) (if (zero? n) n (+ (A084505 (-1+ n)) (A084506 n))))
(definec (A084515 n) (if (zero? n) n (+ (A084515 (-1+ n)) (A084516 n))))
(definec (A084525 n) (if (zero? n) n (+ (A084525 (-1+ n)) (A084526 n))))

;; A084506(130)=6
(define A084506 (compose-funs vector-length nth-successful-test-vec-3-0))
(define A084516 (compose-funs vector-length nth-successful-test-vec-3-1))
(define A084526 (compose-funs vector-length nth-successful-test-vec-3-2))

;; Zero-based, the first occurrence of n in A0845[0-2]1:
(define (A084507 n) (let loop ((i 1)) (cond ((= n (A084501 i)) i) (else (loop (1+ i))))))
(define (A084517 n) (let loop ((i 1)) (cond ((= n (A084511 i)) i) (else (loop (1+ i))))))
(define (A084527 n) (let loop ((i 1)) (cond ((= n (A084521 i)) i) (else (loop (1+ i))))))

;; charfun-for-A084508 differs from the characteristic function of A007489 first time
;; at n=129 (where the former gets value 1, while the latter gets next time
;; value 1 at n=153.)
;; Don't submit these three, there are enough thrash in OEIS already:
(definec (charfun-for-A084508 n) (- (A084506 (1+ n)) (A084506 n)))
(definec (charfun-for-A084518 n) (- (A084516 (1+ n)) (A084516 n)))
(definec (charfun-for-A084528 n) (- (A084526 (1+ n)) (A084526 n)))

(define A084449v2 (cacfun-for-posfun A084451 0 7))

;; See 
;; http://www.research.att.com/cgi-bin/access.cgi/as/njas/sequences/eisA.cgi?Anum=A007489
;; (partial sums of factorials, Sum k!, k=1..n. 0,1,3,9,33,153,
;; (map A084508 (iota 7)) --> (1 3 9 33 129 513 2049)

(definec (A084508 n) (if (zero? n) n (+ (A084508 (-1+ n)) (A084509 n))))

(define A084508v2 (cacfun-for-posfun charfun-for-A084508 1 1))
(define A084518 (cacfun-for-posfun charfun-for-A084518 1 1))
(define A084528 (cacfun-for-posfun charfun-for-A084528 1 1))

;; Is the first essentially equivalent to: 1,2, followed by: (checked upto n=8 -> 6144).
;; A002023 = 6,24,96,384,1536,6144,24576,98304,393216,1572864,6291456,... ?
;; Name:      6*4^n.
;; Yes, see Burkard Polster, The Mathematics of Juggling, Springer-Verlag, 2003, page 48.
;; (ISBN 0-387-95513-5)

;; These were not in OEIS:
;; (map A084509 (iota 8)) --> (1 2 6 24 96 384 1536 6144 24576)
;; (map A084519 (iota 7)) --> (1 1 3 13 47 173 639 2357 8695)
;; (map A084529 (iota 7)) --> (1 1 3 12 42 142 502 1702 5878)

(definec (A084509 n) (if (< n 4) (! n) (* 4 (A084509 (-1+ n)))))

(define (A084509v2 n) (if (= 1 n) (A084508 1) (- (A084508 n) (A084508 (-1+ n)))))
(define (A084519 n) (if (= 1 n) (A084518 1) (- (A084518 n) (A084518 (-1+ n)))))
(define (A084529 n) (if (= 1 n) (A084528 1) (- (A084528 n) (A084528 (-1+ n)))))



;; Maple code:
;;
;; A084509 := n -> `if`((n<4),n!,6*(4^(n-3)));
;; with(combinat); A084519 := proc(n) option remember; local c,i,k;
;;  A084509(n)-add(add(mul(A084519(i),i=c),c=composition(n,k)),k=2..n);
;; end;
;;
;; Is there a simpler way to define A084519 ???
;; See also http://www.cs.brandeis.edu/~ira/papers/enum.pdf page 8
;; for indecomposable permutations (A003319), and their g.f.:
;; > powseries[powcreate](f(n)=n!): tpsform(f,x,8);
;; 
;;               2      3       4        5        6         7      8
;;    1 + x + 2 x  + 6 x  + 24 x  + 120 x  + 720 x  + 5040 x  + O(x )
;; 
;; > g := powseries[inverse](f): tpsform(g,x,8);
;; 
;;               2      3       4       5        6         7      8
;;      1 - x - x  - 3 x  - 13 x  - 71 x  - 461 x  - 3447 x  + O(x )
;; 
;; > 
;; > powseries[powcreate](h(n)=`if`((n<4),n!,6*(4^(n-3)))): powseries[tpsform](h,x,8);
;; 
;;                2      3       4       5        6         7      8
;;     1 + x + 2 x  + 6 x  + 24 x  + 96 x  + 384 x  + 1536 x  + O(x )
;; 
;; > j := powseries[inverse](h): powseries[tpsform](j,x,9);
;; 
;;          2      3       4       5        6        7         8      9
;; 1 - x - x  - 3 x  - 13 x  - 47 x  - 173 x  - 639 x  - 2357 x  + O(x )
;; 
;; > [seq(A084509(n),n=1..12)];
;; 
;;   [1, 2, 6, 24, 96, 384, 1536, 6144, 24576, 98304, 393216, 1572864]
;; 
;; > [seq(A084519(n),n=1..12)];
;; 
;;   [1, 1, 3, 13, 47, 173, 639, 2357, 8695, 32077, 118335, 436549]
;; 
;; > INVERTi([seq(A084509(n),n=1..12)]);
;; 
;;   [1, 1, 3, 13, 47, 173, 639, 2357, 8695, 32077, 118335, 436549]
;; 
;; > INVERT([seq(A084519(n),n=1..12)]);
;; 
;;   [1, 2, 6, 24, 96, 384, 1536, 6144, 24576, 98304, 393216, 1572864]
;;


;; 84551 --- 84560

;; Zero-based, the first occurrence of n in A084452 & A084458:
;; Does 2 occur ever? Start computing from n=3. Not submitted yet.
;; (define (A084552 n) (let loop ((i 1)) (cond ((= n (A084452 i)) i) (else (loop (1+ i))))))
;; (define (A084558 n) (let loop ((i 1)) (cond ((= n (A084458 i)) i) (else (loop (1+ i))))))
;; More to come.

;; Zero-based:
(definec (! n) (if (zero? n) 1 (* n (! (-1+ n))))) ;; A000142
(definec (A007489 n) (if (zero? n) 0 (+ (! n) (A007489 (-1+ n)))))
(definec (A084555 n) (if (zero? n) 0 (+ (A084556 n) (A084555 (-1+ n))))) ;; PSUM of next
(definec (A084556 n) (first_pos_with_funs_val_gte A007489 n)) ;; n occurs n! times.
(definec (A084557 n) (first_pos_with_funs_val_gte A084555 n)) ;; n occurs A084556(n) times

;; (equal? (map A084505 (iota0 129)) (map A084555 (iota0 129))) --> #t
;; (A084505 130) --> 605
;; (A084555 130) --> 604

;; (equal? (map A084500 (iota0 604)) (map A084557 (iota0 604))) --> #t
;; (A084500 605) --> 130
;; (A084557 605) --> 131

;; (equal? (map A084506 (iota0 130)) (map A084556 (iota0 130))) --> ()
;; (A084506 130) --> 6
;; (A084556 130) --> 5


;; (output-check-html "C:\\matikka\\seqs\\juggling.htm" check-juggling 119 45 #f)
(define check-juggling
 (list
;; Permutations:
       (list 120 1 84469 A084469 A084470)
       (list 120 1 84470 A084470 A084469)

       (list 120 1 84453 A084453 A084454)
       (list 120 1 84454 A084454 A084453)

       (list 120 1 84455 A084455 A084466 (list A084455v2))
       (list 120 1 84466 A084466 A084455)


       (list 120 1 84459 A084459 A084460)
       (list 120 1 84460 A084460 A084459)

       (list 120 1 84461 A084461 A084462 (list A084461v2))
       (list 120 1 84462 A084462 A084461)


       (list 120 1 84489 A084489 A084490)
       (list 120 1 84490 A084490 A084489)

       (list 120 1 84491 A084491 A084492 (list A084491v2))
       (list 120 1 84492 A084492 A084491)


       (list 120 1 84493 A084493 A084494)
       (list 120 1 84494 A084494 A084493)

       (list 120 1 84495 A084495 A084496 (list A084495v2))
       (list 120 1 84496 A084496 A084495)


       (list 120 1 84497 A084497 A084498)
       (list 120 1 84498 A084498 A084497)

       (list 120 1 84499 A084499 A084530 (list A084499v2))
       (list 120 1 84530 A084530 A084499)

;; Other, related to A084452 & A084458:

       (list  15 0 84449 A084449 #f (list A084449v2))
       (list  14 0 84465 A084465)

       (list  80 0 84450 A084450)
       (list 100 0 84451 A084451)
       (list 120 1 84452 A084452)

       (list  80 0 84456 A084456)
       (list 100 0 84457 A084457)
       (list 120 1 84458 A084458)

       (list 100 1 84463 A084463)
       (list 100 1 84464 A084464)

       (list 100 1 84467 A084467)
       (list 100 1 84468 A084468)

;; related to three variants of 3-ball ground-state sequences:
       (list 100 0 84500 A084500)
       (list 100 0 84510 A084510)
       (list 100 0 84520 A084520)

       (list 120 1 84501 A084501)
       (list 120 1 84511 A084511)
       (list 120 1 84521 A084521)

       (list 120 1 84502 A084502)
       (list 120 1 84512 A084512)
       (list 120 1 84522 A084522)

       (list 100 0 84503 A084503)
       (list 100 0 84513 A084513)
       (list 100 0 84523 A084523)

       (list  80 0 84504 A084504)
       (list  80 0 84514 A084514)
       (list  80 0 84524 A084524)

       (list 100 0 84505 A084505)
       (list 100 0 84515 A084515)
       (list 100 0 84525 A084525)

       (list 130 1 84506 A084506)
       (list 120 1 84516 A084516)
       (list 120 1 84526 A084526)

       (list  12 0 84507 A084507)
       (list  12 0 84517 A084517)
       (list  12 0 84527 A084527)

       (list  62 0 84508 A084508)
       (list   9 1 84518 A084518)
       (list   9 1 84528 A084528)

       (list  80 1 84509 A084509)
       (list   8 1 84519 A084519)
       (list   8 1 84529 A084529)

       (list 130 0 84555 A084555)
       (list 130 0 84556 A084556)
       (list 130 0 84557 A084557)

 )
)