;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; ;;
;; http://www.research.att.com/~njas/sequences/A126000.scm.txt ;;
;; ;;
;; Coded by Antti Karttunen (his-firstname.his-surname(-AT-)gmail.com), ;;
;; December 2006. (some parts are older, e.g. functions A106485-7). ;;
;; ;;
;; This file contains the Scheme-functions that compute the sequences ;;
;; A106485-A106487 & A1259xx-A126xxx ;;
;; found in ;;
;; Neil Sloane's On-Line Encyclopedia of Integer Sequences (OEIS) ;;
;; available at ;;
;; http://www.research.att.com/~njas/sequences/ ;;
;; ;;
;; Copy of THIS source file is also available at: ;;
;; http://www.iki.fi/kartturi/matikka/Schemuli/A126000.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/ ;;
;; ;;
;; See also http://cgsuite.sourceforge.net/ (Combinatorial Game Suite) ;;
;; http://www.ics.uci.edu/~eppstein/cgt/ ;;
;; http://www.gustavus.edu/~wolfe/papers (David Wolfe's papers) ;;
;; See for example the definitions given in ;;
;; "The structure of the distributive lattice of games born by day n", ;;
;; a paper by W. Fraser, S. Hirshberg and D. Wolfe. ;;
;; ;;
;; If you have improvements, suggestions, additions, please send them ;;
;; to me with e-mail (with subject TOPIC: CGT-related sequences) and ;;
;; I might add them to this program. Alternatively, you can send the ;;
;; improved program directly to Neil Sloane. ;;
;; ;;
;; Last edited December 19 2006 by Antti Karttunen. ;;
;; ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; ;;
;; To do: ;;
;; ;;
;; Implement also the addition of two games. ;;
;; Use S-expressions, because A106486-codes soon grow ridiculously large ;;
;; One possible representation: (() . ()) = (()) = game zero, {|} ;;
;; ((A B C) . (X Y Z)) = ((A B C) X Y Z) = game {A,B,C|X,Y,Z} ;;
;; (( (() . ()) ) . ()) = (((()))) = game {0|} = game 1. ;;
;; (() . ( (() . ()) )) = (() (())) = game {|0} = game -1. ;;
;; (( (() . ()) ) . ( (() . ()) )) = (((())) (())) = game {0|0} = * ;;
;; Conversion back to A106486-codes should be well-defined. ;;
;; Presumably the options of the left and right sides are given in ;;
;; some order, although different orderings of the same sequence (list) ;;
;; map to the same set of options. ;;
;; ;;
;; If the game {A,B,C|X,Y,Z} is presented instead as ;;
;; (*A057163(A B C) . (X Y Z)) ;;
;; then (at least I think so) *A057163 will induce ;;
;; the same negation of games as A106485, and those CGT-trees that are ;;
;; symmetric, will produce also symmetric binary trees (S-expressions) ;;
;; if the ordering used for left's and right's options is same. ;;
;; ;;
;; First version that funnels the result through A126012, i.e. giving ;;
;; the minimal representative of the sum, i.e. A126012(g+h) ;;
;; ;;
;; Second version A126013(A126012(A126011(i)+A126011(j))), operating ;;
;; only with the indices of minimal representatives should give an array ;;
;; where each row and column is a permutation of A001477, because ;;
;; the addition of combinatorial games forms a group. ;;
;; ;;
;; Then another, where the sum is somehow "naturally expanded" ;;
;; (by slicing the new options at appropriate levels), ;;
;; and then left as nonminimal code, not using any of A126011-A126013. ;;
;; (This would produce HUGE encodings.) ;;
;; Questions: a lots of silly questions. ;;
;; ;;
;; Also to do: distributive lattice of games, an example array of meets ;;
;; and joins, utilizing the indices (i.e. A126011 - A126013.) ;;
;; ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(declare (usual-integrations))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; ;;
;; Auxiliary macros for defining cached ("memoized") N -> N functions, ;;
;; and like. ;;
;; ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; define unary cached N -> anything 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* 128) ;; 131072. No need to cache so much here!
(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
)
;; This is for defining one-based permutations.
;; Stores automatically also the inverse permutation (in _invcache_),
;; which can be accessed with negative arguments.
;; Note that the defined function is subtly state-dependent. The defined permutation must be
;; computed before its inverse!
;; Yes, this is dirty and dangerous.
(define-syntax defineperm1
(syntax-rules ()
((defineperm1 (name arg) e0 ...)
(define name
(letrec
((_cache_ (vector #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f))
(_invcache_ (vector #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f)) ;; For inverses.
(name
(lambda (arg)
(cond ((null? arg) _cache_)
((eq? #t arg) _invcache_)
((< arg 0) ;; (foo -n) means (foo^-1 n)
(cond ((>= (- arg) (vector-length _invcache_)) #t)
(else (vector-ref _invcache_ (- arg)))
)
)
((>= arg *MAX-CACHE-SIZE-FOR-DEFINEC*)
e0 ...
)
(else
(if (and (>= arg (vector-length _cache_))
(< arg *MAX-CACHE-SIZE-FOR-DEFINEC*)
)
(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)
(let ((invcachesize (vector-length _invcache_)))
(if (< arg *MAX-CACHE-SIZE-FOR-DEFINEC*)
(vector-set! _cache_ arg res)
)
;; Handle the inverse cache. First ensure that there's enough space:
(cond ((and (< res *MAX-CACHE-SIZE-FOR-DEFINEC*)
(or (>= res invcachesize) (>= arg invcachesize))
)
(set! _invcache_
(vector-grow
_invcache_
;; (min *MAX-CACHE-SIZE-FOR-DEFINEC*
(max (1+ res)
(1+ (vector-length _cache_))
(* 2 (vector-length _invcache_))
)
;; )
)
)
(format #t "Inverse cache size: ~a -> ~a.\n"
invcachesize (vector-length _invcache_)
)
)
;; If this result was already stored in invcache, then check that it was not cached for different arg:
((and (< res *MAX-CACHE-SIZE-FOR-DEFINEC*)
(vector-ref _invcache_ res)
)
=>
(lambda (old_n)
(if (not (= old_n arg))
(error (format #f
"The defined function is not injective, so it cannot be bijection: f(~a)=f(~a)=~a.\n"
old_n arg res)
)
)
)
)
)
(if (< res *MAX-CACHE-SIZE-FOR-DEFINEC*)
(vector-set! _invcache_ res arg)
)
res
)
) ;; (lambda (res) ...)
(begin e0 ...)
)
)
)
) ; cond
)
)
) ; letrec-definitions
name
) ; letrec
) ;; (define name ...)
)
) ;; syntax-rules
)
;; pred_on_i? should be N -> #f/#t function, starting from offset 0.
(define (fun-succ-matching-is1 pred_on_i?)
(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 ((= 0 n) -1)
(else
(let loop ((i (1+ (tvimadur (-1+ n)))))
(cond ((pred_on_i? i) i)
(else (loop (1+ i)))
)
)
)
)
) ;; Invocation of the lambda-form
) ;; or
) ;; else
) ;; cond
) ; lambda (n)
)
) ;; letrec-definitions.
tvimadur
) ;; letrec
)
;; fun_on_i should be N -> N function, starting from offset 0, preferably cached.
(define (fun-succ-distincts0 fun_on_i)
(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 ((< n 1) n)
(else
(let outloop ((i (1+ (belgthor (-1+ n))))
(val_here (fun_on_i (1+ (belgthor (-1+ n)))))
)
(let inloop ((j (-1+ n))) ;; ((j (-1+ i)))
;; If we didn't find any j < i where fun_on_i(belgthor(j)) would have been belgthor(i), then ...
(cond ((< j 0) i) ;; ... we found a new distinct value.
((= (fun_on_i (belgthor j)) val_here)
(outloop (+ i 1) (fun_on_i (+ i 1)))
)
(else (inloop (- j 1)))
)
)
)
)
)
) ;; Invocation of the lambda-form
) ;; or
) ;; else
) ;; cond
) ; lambda (n)
)
) ;; letrec-definitions.
belgthor
) ;; letrec
)
;; fun_on_i should be N -> N function, starting from offset 0, preferably cached.
(define (fun-succ-distincts-cgts0 fun_on_i)
(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 ((< n 1) n)
(else
(let outloop ((i (1+ (belgthor (-1+ n))))
(val_here (fun_on_i (1+ (belgthor (-1+ n)))))
)
(let inloop ((j (-1+ n))) ;; ((j (-1+ i)))
;; If we didn't find any j < i where fun_on_i(belgthor(j)) would have been belgthor(i), then ...
(cond ((< j 0) i) ;; ... we found a new distinct value.
((= 1 (A126010bi (fun_on_i (belgthor j)) val_here))
(outloop (+ i 1) (fun_on_i (+ i 1)))
)
(else (inloop (- j 1)))
)
)
)
)
)
) ;; Invocation of the lambda-form
) ;; or
) ;; else
) ;; cond
) ; lambda (n)
)
) ;; letrec-definitions.
belgthor
) ;; letrec
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (first_pos_with_funs_val_gte fun n)
(let loop ((i 0))
(if (>= (fun i) n) i
(loop (1+ i))
)
)
)
(define (first-n-where-fun_n-is-i1 fun i)
(let loop ((n 1))
(cond ((= i (fun n)) n)
(else (loop (+ n 1)))
)
)
)
(define (num-of-n-where-fun_n-is-less-than-i fun i)
(let loop ((n 0))
(cond ((>= (fun n) i) n)
(else (loop (+ n 1)))
)
)
)
(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)))
)
)
)
(define (pos-of-first-matching lista pred?)
(let loop ((lista lista) (i 0))
(cond ((null? lista) #f)
((pred? (car lista)) i)
(else (loop (cdr lista) (1+ i)))
)
)
)
(define (compose-funlist funlist)
(cond ((null? funlist) (lambda (x) x))
(else (lambda (x) ((car funlist) ((compose-funlist (cdr funlist)) x))))
)
)
(define (compose-funs . funlist)
(cond ((null? funlist) (lambda (x) x))
(else (lambda (x) ((car funlist) ((apply compose-funs (cdr funlist)) x))))
)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (obtain-integer-bitwise-function bit-string-FUN)
(lambda (x y)
(let ((size (max (binwidth x) (binwidth y))))
(bit-string->unsigned-integer
(bit-string-FUN (unsigned-integer->bit-string size x)
(unsigned-integer->bit-string size y)
)
)
)
)
)
(define A003986bi (obtain-integer-bitwise-function bit-string-or))
(define A003987bi (obtain-integer-bitwise-function bit-string-xor))
(define A004198bi (obtain-integer-bitwise-function bit-string-and))
(define (pow2? n) (and (> n 0) (zero? (A004198bi n (- n 1)))))
(define (A004442 n) (A003987bi n 1)) ;; Natural numbers, pairs reversed: a(n) = n + (-1)^n; n XOR 1.
(definec (binomial_n_2 n) (/ (* (-1+ n) n) 2))
;; (map A025581 (cons 0 (iota 20))) --> (0 1 0 2 1 0 3 2 1 0 4 3 2 1 0 5 4 3 2 1 0)
(definec (A025581 n) ;; The X component (column) of square {0..inf} arrays
(- (binomial_n_2 (1+ (floor->exact (+ (/ 1 2) (sqrt (* 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 (+ (/ 1 2) (sqrt (* 2 (1+ n)))))))
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(definec (on-bit-indices n)
(let loop ((n n)
(i 0)
(c (list))
)
(cond ((zero? n) (reverse! c))
((odd? n) (loop (/ (- n 1) 2) (+ 1 i) (cons i c)))
(else (loop (/ n 2) (+ 1 i) c))
)
)
)
(define (halve n) (/ n 2))
(define (shr n) (if (odd? n) (/ (- n 1) 2) (/ n 2)))
(definec (left-options n) (map halve (keep-matching-items (on-bit-indices n) even?)))
(definec (right-options n) (map halve (map -1+ (keep-matching-items (on-bit-indices n) odd?))))
;; . = 0
;; \ = 1
;; / = 2
;; \/ = 3
;; \
;; / = 8
;; /
;; \ = 16
;; \
;; \ = 4
;; /
;; / = 32
;; \
;; \ \ \ \/ \/
;; \/ = 9 \/ = 12 \/ = 129 \/ = 524289 = 2^(2*9+1)+1
(definec (A057300 n)
(reduce + 0 (map (lambda (i) (expt 2 i)) (map A004442 (on-bit-indices n))))
)
(definec (A106485 n) ;; negate, i.e. take the mirror-image of a CGT-tree.
(let loop ((n n)
(i 0)
(s 0)
)
(cond ((zero? n) s)
((odd? n)
(loop (/ (- n 1) 2)
(+ 1 i)
(+ s
(if (even? i)
(expt 2 (+ 1 (* 2 (A106485 (/ i 2)))))
(expt 2 (* 2 (A106485 (/ (- i 1) 2))))
)
)
)
)
(else (loop (/ n 2) (+ 1 i) s))
)
)
)
(definec (A106486 n)
(cond ((zero? n) 0)
(else (fold-left (lambda (x y) (+ x y 1))
0
(map A106486 (map shr (on-bit-indices n)))
)
)
)
)
;; After a(0), differs from A000120 first time at n=64.
(definec (A106487 n)
(cond ((zero? n) 1)
(else (apply + (map A106487 (map shr (on-bit-indices n)))))
)
)
;; Here are the 40 A-numbers you requested: A125974 --- A126013.
;; The CGT-game with code n has value >= 0, left wins moving second,
;; i.e. either the second player can always win (= 0), OR the left wins
;; regardless whether (s)he playes first or second (> 0).
;; and this happens if the game is either zero game, or:
;; for all G^R: -(G^R) >= 0 and not (G^R >= 0), (i.e. all G^R < 0).
;;
;; Note that if right has no options, then it is immediate win for the left.
(definec (char_A126001 n) ;; Is the CGT game given by A106486-code n >= 0
(cond ((zero? n) 1) ;; Yes, the game zero has CGT value = 0.
((for-all? (right-options n) ;; or there is no right opt Gr <= 0.
(lambda (Gr) (= 0 (char_A126001 (A106485 Gr))))
)
1
)
(else 0)
)
)
;; Alternative formulation.
;; The game G >= 0, if G is either zero game, or for all G^R there is some G^R^L >= 0.
;; Note that if right has no options, then it is immediate win for the left.
;; while if some of the right's options does not have no left options at all,
;; then the left cannot win (if the right plays wisely), and thus char_A126001(n) = 0 in that case.
;; To prove the equivalence of these alternate formulations,
;; we note that the condition in the first formulation is equivalent to:
;;
;; for all G^R, it's false that -(G^R) >= 0
;;
;; which, after expansing one recursion step, turns to:
;;
;; for all G^R, it's false that, that for all (-(G^R))^RR it's false that -((-(G^R))^RR) >= 0
;;
;; (RR refers to right's "second-level" options after the choosing some of his first-level options)
;; But as - is the same as A106485, which reflects the tree, the latter turns out as:
;; (L refers to the left-options after choosing some of the right options)
;;
;; for all G^R, it's false that, that for all G^R^L it's false that ((G^R)^L) >= 0
;;
;; (and as (not universal quantor not condition) <=> (existential quantor condition) we get):
;;
;; for all G^R, there exists some G^R^L such that ((G^R)^L) >= 0
;;
(definec (char_A126001v2 n) ;; Is the CGT game given by A106486-code n >= 0
(cond ((zero? n) 1) ;; Yes, the game zero has CGT value = 0.
((for-all? (right-options n)
(lambda (right-opt)
(there-exists? (left-options right-opt)
(lambda (rlopt) (= 1 (char_A126001v2 rlopt)))
)
)
)
1
)
(else 0)
)
)
(define (char_A125991 n) (* (char_A126001 n) (char_A126002 n))) ;; Zero game? Characteristic function for A125991
(define (char_A126002 n) (char_A126001 (A106485 n))) ;; Is the CGT game given by A106486-code n <= 0 ?
(define (char_A126003 n) (* (- 1 (char_A126001 n)) (- 1 (char_A126002 n)))) ;; Is the game with code n fuzzy relative to zero game?
(define (char_A126004 n) (* (char_A126001 n) (- 1 (char_A126002 n)))) ;; strictly positive?
(define (char_A126005 n) (* (char_A126002 n) (- 1 (char_A126001 n)))) ;; strictly negative?
(define A125991v2 (fun-succ-matching-is1 (lambda (i) (= 1 (char_A125991 i)))))
(define A126001 (fun-succ-matching-is1 (lambda (i) (= 1 (char_A126001 i)))))
(define A126002 (fun-succ-matching-is1 (lambda (i) (= 1 (char_A126002 i))))) ;; Is not A079599, A047467
(define A126003 (fun-succ-matching-is1 (lambda (i) (= 1 (char_A126003 i))))) ;; Is not A047556.
(define A126004 (fun-succ-matching-is1 (lambda (i) (= 1 (char_A126004 i)))))
(define A126005 (fun-succ-matching-is1 (lambda (i) (= 1 (char_A126005 i)))))
(define (A126010bi g h) ;; Is the CGT game g >= h and h >= g, i.e. g and h have the same CGT-value?
(* (A125999bi g h) (A125999bi h g))
)
(define (A125999bi g h) ;; Is the CGT game g >= h ?
(cond ((zero? h) (char_A126001 g))
((zero? g) (char_A126001 (A106485 h))) ;; If g = 0, equivalent to -h >= g, i.e. h <= 0.
((there-exists? (right-options g) ;; If there is an right opt Gr <= H, then not!
(lambda (Gr) (= 1 (A125999bi h Gr)))
) 0
)
((there-exists? (left-options h) ;; Or if there is an left opt Hl >= G, then not!
(lambda (Hl) (= 1 (A125999bi Hl g)))
) 0
)
(else 1) ;; CGT-value of g is >= h.
)
)
(definec (A126012 n) ;; Find the minimal representative CGT-code for n. Zero-based!
(let loop ((i 0))
(if (= 1 (A126010bi i n)) i ;; Found it.
(loop (+ 1 i)) ;; Guaranteed to stop at least when i = n.
)
)
)
;; Sequence A126011, column 1 of table A126000, minimal codes for each CGT-tree:
;; positions where A126012 gets distinct new values (which are also records).
;; I haven't examined whether it would make much sense to implement
;; the pruning of the dominated options and reversing of the
;; dominated options. However, it testifies to the elegance of the original
;; inductive formulations of the C.G.T. that the same results
;; are obtained even without any such optimizations,
;; with such simple definition as A125998bi has.
;; And again, we are more interested about getting correct
;; rather than fast results:
;; (here up to n=57):
;; 0,1,2,3,4,6,9,12,18,32,33,36,48,66,67,96,97,129,131,132,134,195,
;; 256,258,264,288,384,386,516,768,4098,4099,4102,4128,4129,4132,4227,
;; 4230,8196,8198,8204,8448,8450,8456,12294,262146,262152,262176,262272,
;; 262274,266242,266272,266370,524289,524292,524544,532484,532736
(define A126011 (fun-succ-distincts-cgts0 (lambda (x) x))) ;; Zero-based, not so slow anymore.
(define A126011slow (fun-succ-distincts0 A126012)) ;; Zero-based, really slow.
;; (define A126011 (compose-funs (fun-succ-distincts0 A126012) -1+)) ;; No more one-based.
;; Zero-based also:
(definec (A126013 n) ;; Inverse of A126011, might turn out useful later. Not optimal now.
(cond ((zero? n) 0)
((not (= (A126012 n) n)) 0) ;; n is not the minimal representative of n.
(else (first-n-where-fun_n-is-i1 A126011 n))
)
)
;; (0 2 1 3 9 10 8 12 6 4 5 11 7 17 18 19 20 13 14 15 16 21)
;; Cannot compute now farther than 21, as after that the terms of A106485 o A126011 grow too large:
;; A106485(A126011[0..22])
;; = 0 2 1 3 32 33 18 48 9 4 6 36 12 129 131 132 134 66 67 96 97 195 36893488147419103232
(definec (A126009 n) (A126013 (A106485 (A126011 n))))
;; Not the optimal, but is enough for now: (caching of A126011 helps a bit.)
;; Zero-based. Computed here only up to n=20.
(definec (A125990 n) (num-of-n-where-fun_n-is-less-than-i A126011 (expt 2 n)))
;; Function that caches closures, that themselves are cached ("memoized") functions:
(definec (rowfun_n_for_A126000 n) ;; one-based.
(let ((minrepr (A126011 (- n 1)))) ;; A126011 is zero-based
(fun-succ-matching-is1 (lambda (i) (= 1 (A126010bi i minrepr))))
)
)
(define (A126000bi col row) ((rowfun_n_for_A126000 row) col))
;; It's permutation, but we don't care to compute its inverse! Offsets, you see.
(define (A126000 n) (A126000bi (+ 1 (A025581 (- n 1))) (+ 1 (A002262 (- n 1)))))
(define (A125999 n) (A125999bi (A025581 n) (A002262 n)))
(define (A126010 n) (A126010bi (A025581 n) (A002262 n)))
(define A125991 (rowfun_n_for_A126000 1))
(define A125992 (rowfun_n_for_A126000 2))
(define A125993 (rowfun_n_for_A126000 3))
(define A125994 (rowfun_n_for_A126000 4))
(define A125995 (rowfun_n_for_A126000 5))
(define A125996 (rowfun_n_for_A126000 6))
(define A125997 (rowfun_n_for_A126000 7))
(define A125998 (rowfun_n_for_A126000 8))
;; (output-entries-to-file120_45 Dec2006-list-a "./seqs/A126000-seqs.txt" "Dec 18 2006")
(define Dec2006-list-a
(list
(list 125991 "A106486-encodings of combinatorial games with zero value."
'(off: 1)
'(c: "In these games, the second player can always win.")
(list 'e: (string-append
"Game 0 is encoded as zero, giving the first term of this sequence."
" Also 24 belongs into this sequence, as it encodes game {-1|1}, which the second"
" player always wins. Similarly for game {*|*} which has code 2^(1+2*3) + 2^(2*3) = 192,"
" thus 192 is a member of this sequence."
)
)
(list 'y: (string-append "Row 1 of A126000."
" Intersection of A126001 and A126002."
" Characteristic function occurs as row 0 of A126010."
)
)
)
(list 125992 "A106486-encodings of combinatorial games with value 1."
'(off: 1)
(list 'c: (string-append "These are codes for games which belong to the same"
" equivalence class as the game {0|} (i.e. game 1)."
)
)
(list 'e: (string-append
"Game {0|} is encoded as 2^(2*0) = 1, thus 1 is the first term of this sequence."
" Also 17 belongs into this sequence, as it encodes game {-1,0|}, where, as the option -1 is"
" dominated by option 0, the former can be deleted, resulting the"
" same game {0|}."
" Also code 65536 (= 2^(2*(2^(1+2*1)))) belongs into this sequence,"
" as it encodes the game {{|1}|}, which is reversible to game 1."
)
)
(list 'y: (string-append "Row 2 of A126000."))
)
(list 125993 "A106486-encodings of combinatorial games with value -1."
'(off: 1)
(list 'c: (string-append "These are codes for games which belong to the same"
" equivalence class as the game {|0} (i.e. game -1)."
)
)
(list 'e: (string-append
"Game {|0} is encoded as 2^(1+2*0) = 2, thus 2 is the first term of this sequence."
" Also 10 belongs belongs into this sequence, as it encodes game {|0,1}, where, as the option 0 dominates"
" the option 1, the latter can be deleted, resulting the"
" same game {|0}."
" Likewise code 8589934592 (= 2^(1+(2*2^(2*2)))) belongs into this sequence,"
" as it encodes the game {|{-1|}}, which is reversible to game -1."
)
)
(list 'y: (string-append "Row 3 of A126000."))
)
(list 125994 "A106486-encodings of combinatorial games equivalent to game star."
'(off: 1)
(list 'c: (string-append "These are codes for games which belong to the same"
" equivalence class as the game {0|0} (i.e. game *)."
)
)
(list 'e: (string-append
"Game {0|0} is encoded as 2^(2*0) + 2^(1+2*0) = 3, thus 3 is the first term of this sequence."
" However, 11 also belongs into this sequence, as it encodes game {0|0,1}, where,"
" because the option 0 dominates"
" the option 1 on the right hand side, the latter can be deleted, resulting the"
" same game {0|0}."
)
)
(list 'y: (string-append "Row 4 of A126000. Subset of A126003."))
)
(list 125995 "A106486-encodings of combinatorial games with value 2."
'(off: 1)
(list 'c: (string-append "These are codes for games which belong to the same"
" equivalence class as the game {1|} (i.e. the game 2)."
)
)
(list 'e: (string-append
"Game {1|} is encoded as 2^(2*1) = 4, thus 4 is the first term of this sequence."
" Also 5 belongs into this sequence, as it encodes game {0,1|}, where, because the option 1 dominates"
" the option 0 on the left side, the zero can be deleted, resulting the"
" same game {1|}."
)
)
(list 'y: (string-append "Row 5 of A126000."))
)
(list 125996 "A106486-encodings of combinatorial games equivalent to game {1|0}."
'(off: 1)
(list 'c: (string-append "These are codes for games which belong to the same"
" equivalence class as the game {1|0}."
)
)
(list 'e: (string-append
"Game {1|0} is encoded as 2^(2*1) + 2^(1+2*0) = 6, thus 6 is the first term of this sequence."
" Also 7 belongs into this sequence, as it encodes game {0,1|0}, where, as the option 1 dominates"
" the option 0 on the left side, the former can be deleted, resulting the"
" same game {1|0}."
)
)
(list 'y: (string-append "Row 6 of A126000."))
)
(list 125997 "A106486-encodings of combinatorial games equivalent to game {0|1}."
'(off: 1)
(list 'c: (string-append "These are codes for games which belong to the same"
" equivalence class as the game {0|1}."
)
)
(list 'e: (string-append
"Game {0|1} is encoded as 2^(2*0) + 2^(1+2*1) = 9, thus 9 is the first term of this sequence."
" Also 25 (= 2^(2*2) + 2^(2*0) + 2^(1+2*1)) belongs into this sequence, as it encodes game"
" {-1,0|1}, where, as the option -1 is dominated by option 0, the former can be deleted,"
" resulting the same game {0|1}."
)
)
(list 'y: (string-append "Row 7 of A126000."))
)
(list 125998 "A106486-encodings of combinatorial games equivalent to game {1|1}."
'(off: 1)
(list 'c: (string-append "These are codes for games which belong to the same"
" equivalence class as the game {1|1}, the impartial game 1*."
)
)
(list 'e: (string-append
"Game {1|1} is encoded as 2^(2*1) + 2^(1+2*1) = 12, thus 12 is the first term of this sequence."
" Also 13 belongs into this sequence, as it encodes game"
" {0,1|1}, where, as the option 0 is dominated by option 1, the former can be deleted,"
" resulting the same game {1|1}."
)
)
(list 'y: (string-append "Row 8 of A126000."))
)
(list 126001 "A106486-encodings of nonnegative combinatorial games, i.e. games whose value is >= 0."
'(off: 1)
'(c: "In these games, the left can always win if he is to play second.")
;; '(comps: (126002 106485)) ;; Would be true for characteristic functions!
(list 'y: (string-append "Characteristic function occurs as row 0 of A125999."
" Cf. A125991, A126003-A126005."
)
)
)
(list 126002 "A106486-encodings of combinatorial games whose value is <= 0."
'(off: 1)
'(c: "In these games, the right can always win if he is to play second.")
;; '(comps: (126001 106485)) ;; Would be true for characteristic functions!
(list 'y: (string-append "Characteristic function occurs as column 0 of A125999."
" Differs from A047467 (a(65)=512, not 256),"
" and also from A079599, as the term 18446744073709551616 (= 2^64)"
" is a member of this sequence but not of A079599."
" Cf. A125991, A126003-A126005."
)
)
)
(list 126003 "A106486-encodings of combinatorial games whose value is fuzzy relative to game zero."
'(off: 1)
'(c: "In these games, the first player can always win.")
(list 'y: (string-append
"Intersection of the complements of A126001 and A126002,"
" or equally, complement of the union of A126001 and A126002."
" Differs from A047556."
" Cf. A125991, A125994, A126004-A126005."
)
)
)
(list 126004 "A106486-encodings of combinatorial games whose value is greater than zero."
'(off: 1)
'(c: "In these games, the left can always win.")
;; '(comps: (126005 106485)) ;; Would be true for characteristic functions!
(list 'y: (string-append "Intersection of complement of A126002 and A126001."
" Cf. A125991, A126001-A126003."
)
)
)
(list 126005 "A106486-encodings of combinatorial games whose value is less than zero."
'(off: 1)
'(c: "In these games, the right can always win.")
;; '(comps: (126004 106485)) ;; Would be true for characteristic functions!
(list 'y: (string-append
"Intersection of complement of A126001 and A126002."
" Cf. A125991, A126001-A126003."
)
)
)
(list 126010 "Square array A(g,h) = 1 if combinatorial games g and h have the same value, 0 if they differ, listed antidiagonally in order A(0,0), A(1,0), A(0,1), A(2,0), A(1,1), A(0,2), ..."
'(keywords: "tabl")
'(off: 0)
'(upto: 120)
'(c: "Here we use the encoding described in A106486.")
(list 'e: (string-append "A(4,5) = A(5,4) = 1, because 5 encodes the game {0,1|}, "
" where, because the option 1 dominates the option 0 on the left side, the zero can be deleted,"
" resulting the game {1|}, the canonical form of the game 2, which is encoded as 4."
)
)
(list 'y: (string-append
"Row 0 is the characteristic function of A125991 (shifted one step)."
" A(i,j) = A125999(i,j)*A125999(j,i)."
" A126011 gives the A106486-encodings for the minimal representatives of each"
" equivalence class of finite combinatorial games."
)
)
)
(list 125999 "Square array A(g,h) = 1 if combinatorial game g has value greater than or equal to that of game h, otherwise 0, listed antidiagonally in order A(0,0), A(1,0), A(0,1), A(2,0), A(1,1), A(0,2), ..."
'(off: 0)
'(upto: 120)
'(c: "Here we use the encoding explained in A106486. A(i,j) = A(A106485(j),A106485(i)).")
'(keywords: "tabl")
(list 'y: (string-append
"Row 0 is the characteristic function of A126001 (shifted one step),"
" and similarly, column 0 is the characteristic function of A126002."
" Cf. A126010 and table A126000."
)
)
)
;; 0,1,2,3,4,6,9,12,18,32,33,36,48,66,67,96,97,129,131,132,134,195,256,258,264,288,384,386,516,768
(list 126011 "A106486-encodings for the minimal representatives of each equivalence class of the finite combinatorial games."
'(off: 0)
'(upto: 61)
(list 'c:
(string-append "The initial terms correspond with the following games:"
" code 0 = {|} = the zero game,"
" code 1 = {0|} = game 1,"
" code 2 = {|0} = game -1,"
" code 3 = {0|0} = game *,"
" code 4 = {1|} = game 2,"
" code 6 = {1|0},"
" code 9 = {0|1} = game 1/2,"
" code 12 = {1|1} = game 1*,"
" code 18 = {-1|0} = game -1/2,"
" code 32 = {|-1} = game -2,"
" code 33 = {0|-1},"
" code 36 = {1|-1} = game +-1,"
" code 48 = {-1|-1} = game -1*,"
" code 66 = {*|0} = game down,"
" code 67 = {0,*|0} = game up*," ;; 2^(2*3) + 2^(2*0) + 2^(1+2*0)
" code 96 = {*|-1}," ;; 2^(2*3) + 2^(1+2*2)
" code 97 = {0,*|-1}," ;; 2^(2*3) + 2^(2*0) + 2^(1+2*2)
" code 129 = {0|*} = game up," ;; 2^(2*0) + 2^(1+2*3)
" code 131 = {0|0,*} = game down*," ;; 2^(2*0) + 2^(1+2*0) + 2^(1+2*3)
" code 132 = {1|*}," ;; 2^(2*1) + 2^(1+2*3)
" code 134 = {1|0,*}," ;; 2^(2*1) + 2^(1+2*3) + 2^(1+2*0)
" code 195 = {0,*|0,*} = game *2," ;; 2^(2*3) + 2^(2*0) + 2^(1+2*3) + 2^(1+2*0)
" code 256 = {2|} = game 3." ;; 2^(2*4)
" Encoding is explained in A106486."
)
)
(list 'y: (string-append "Records of A126012. Column 1 of A126000. Inverse: A126013. See A126010."
"A125990 gives the number of terms in range [0,2^n[. Cf. A065401."
)
)
)
(list 126012 "A106486-encoding of the canonical representative of the combinatorial game with code n."
'(off: 0)
(list 'e: (string-append
"25 (= 2^(2*2) + 2^(2*0) + 2^(1+2*1)) encodes the game {-1,0|1}, where,"
" as the option -1 is dominated by option 0, the former can be deleted,"
" giving us the game {0|1}, i.e. the canonical (minimal) form of the game 1/2,"
" encoded as 2^(2*0) + 2^(1+2*1) = 9, thus a(25)=9 and a(9)=9."
" Similarly a(65536)=1, as 65536 (= 2^(2*(2^(1+2*1)))) encodes the game {{|1}|},"
" which is reversible to the game {0|}, i.e. the game 1, which is encoded as 2^(2*0) = 1."
)
)
(list 'y: (string-append "A126011 gives the distinct terms (and also the records)."))
)
(list 126013 "Inverse function of N ->N injection A126011."
'(off: 0)
;; '(upto: 99)
(list 'c: (string-append
"a(0)=0 because A126011(0)=0, but a(n) = 0 also for those n which do not occur as values of A126011."
" All positive natural numbers occur here once."
)
)
(list 'y: (string-append "a(A126011(n)) = n for all n."))
)
(list 126009 "Self-inverse permutation of integers induced when A106485 is rectricted to A126011."
'(off: 0)
'(upto: 21)
'(indentries: Nperm)
'(inv: 126009)
'(comps: (126013 106485 126011))
(list 'c: (string-append
"It's not easy to compute this further than n=21, as A106485(A126011(22))=36893488147419103232."
)
)
)
(list 125990 "Number of partisan games for which A106486-encoding of the minimal representation is less than < 2^n."
'(off: 0)
'(upto: 20)
'(c: "Number of terms of A126011 in range [0,2^n[.")
'(y: "A065401(n) = a(2*A114561(n)).")
)
(list 126000 "Table giving A106486-codes for each equivalence class of combinatorial games."
'(off: 1)
'(indentries: Nperm)
'(keywords: "tabl")
(list 'e: (string-append
"Each row lists the integers that encode the games with the same value as the initial term"
" of the row:"
"\n%e A126000 0,8,16,24,64,72,80,88,128,136,144,152,192,200,208,..."
"\n%e A126000 1,17,65,81,513,529,577,593,2049,2065,2113,2129,2561,..."
"\n%e A126000 2,10,130,138,514,522,642,650,2050,2058,2178,2186,..."
"\n%e A126000 3,11,19,27,515,523,531,539,2051,2059,2067,2075,2563,..."
"\n%e A126000 4,5,20,21,68,69,84,85,4100,4101,4116,4117,4164,4165,..."
"\n%e A126000 6,7,14,15,22,23,30,31,70,71,78,79,86,87,94,95,518,..."
"\n%e A126000 9,25,73,89,521,537,585,601,2057,2073,2121,2137,2569,..."
"\n%e A126000 12,13,28,29,76,77,92,93,524,525,540,541,588,589,604,..."
"\n%e A126000 18,26,146,154,530,538,658,666,2066,2074,2194,2202,..."
"\n%e A126000 32,34,40,42,160,162,168,170,544,546,552,554,672,674,..."
"\n%e A126000 33,35,41,43,49,51,57,59,161,163,169,171,177,179,185,..."
"\n%e A126000 36,37,38,39,44,45,46,47,52,53,54,55,60,61,62,63,100,..."
"\n%e A126000 48,50,56,58,176,178,184,186,560,562,568,570,688,690,..."
"\n%e A126000 66,74,82,90,194,202,210,218,578,586,594,602,706,714,..."
)
)
(list 'c: (string-append "See the comments on A126011 and on the individual rows."))
(list 'y: (string-append
"Column 1: A126011."
" Row 1: A125991, row 2: A125992, row 3: A125993,"
" row 4: A125994, row 5: A125995, row 6: A125996, row 7: A125997, row 8: A125998."
)
)
)
)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; ;;
;; Copied and modified from: ;;
;; http://www.iki.fi/~kartturi/matikka/Nekomorphisms/gato-out.scm ;;
;; functions output-gatomorphism-entry-aux et al. ;;
;; ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(load-option 'format)
(define (Anum->str Anum)
(string-append "A"
(string-pad-left (if (string? Anum) Anum (number->string Anum)) 6 #\0)
)
)
(define output_seq
(lambda (seq)
(cond ((null? seq)) ;; No (newline) this time!
(else (write (car seq))
(if (not (null? (cdr seq))) (write-string ","))
(output_seq (cdr seq))
)
)
)
)
(define (len-of-max-full-line-prefix seq max-line-len)
(let loop ((seq seq)
(terms 0)
(room-left max-line-len)
)
(cond ((negative? room-left) (max 1 (- terms 1))) ;; At least one term, even if it is overlength!
((not (pair? seq)) terms)
(else (loop (cdr seq)
(+ 1 terms)
(- room-left (string-length (format #f ",~A" (car seq))))
)
)
)
)
)
(define (html-out-sequence-search-link out seq seeklen)
(with-output-to-port out
(lambda ()
(let ((seek-seq (cond ((< seeklen (- (length seq) 2)) (list-head (cddr seq) seeklen)) (else (cddr seq)))))
(write-string "")
(output_seq (list-head seq (min seeklen (length seq))))
(write-string "\n")
)
)
)
)
(define (html-out-Anchor Anum out)
(format out "" (Anum->str Anum))
)
(define (html-out-sequence-A-link Anum out)
(let ((Astr (Anum->str Anum)))
(format out "~A" Astr Astr)
)
)
;; Works in MIT Scheme:
(define (Anum->Afun Anum)
(eval (string->symbol (string-downcase (Anum->str Anum))) user-initial-environment)
)
;; (complist->exprstr (list 1 2 3 4)) --> "A000001(A000002(A000003(A000004(n))))"
(define (complist->exprstr complist)
(with-string-output-port
(lambda (outport)
(for-each (lambda (anum) (format outport "~A(" (Anum->str anum)))
complist
)
(format outport "n")
(for-each (lambda (x) (format outport ")")) complist)
)
)
)
(define (check-composition outport comp base-seq Aseq Astr check-only?)
(let ((Acomp (compose-funlist (map Anum->Afun comp))))
(cond ((not (equal? (map Acomp base-seq) Aseq))
(format outport "!!! The composition ~A = ~A is not correct!\n"
Astr (complist->exprstr comp)
)
)
(check-only?
(format outport "Yes, the composition ~A = ~A seems to be correct.\n"
Astr (complist->exprstr comp)
)
)
)
)
)
(define (check-entry10 listlet) (output-OEIS-entry listlet 1024 10 #t "Kuu 00 2006" (current-output-port)))
(define (check-entry25 listlet) (output-OEIS-entry listlet 1024 25 #t "Kuu 00 2006" (current-output-port)))
(define (check-entry55 listlet) (output-OEIS-entry listlet 1024 45 #t "Kuu 00 2006" (current-output-port)))
(define (output-entries-to-file120_10 listlets outfile subm-date)
(call-with-output-file outfile
(lambda (outport)
(map (lambda (listlet) (output-OEIS-entry listlet 120 10 #f subm-date outport))
listlets
)
)
)
)
(define (output-entries-to-file120_45 listlets outfile subm-date)
(call-with-output-file outfile
(lambda (outport)
(map (lambda (listlet) (output-OEIS-entry listlet 120 45 #f subm-date outport))
listlets
)
)
)
)
(define (combstringpars x) (reduce string-append "" (cdr x)))
(define (output-OEIS-entry listlet check-upto-n seek-len check-only? subm-date outport)
(let* ((Anum (list-ref listlet 0))
(name (list-ref listlet 1))
(rest-of (cddr listlet))
(c (cond ((assoc 'c: rest-of) => combstringpars) (else #f)))
(e (cond ((assoc 'e: rest-of) => combstringpars) (else #f)))
(f (cond ((assoc 'f: rest-of) => combstringpars) (else #f)))
(y (cond ((assoc 'y: rest-of) => combstringpars) (else #f)))
(off (cond ((assoc 'off: rest-of) => cadr) (else (error "output-entry: field 'off:' (starting offset) required!"))))
(keywords (cond ((assoc 'keywords: rest-of) => combstringpars) (else #f)))
(Ainv (cond ((assoc 'inv: rest-of) => cadr) (else #f)))
(comps (cond ((assoc 'comps: rest-of) => cdr) (else #f))) ;; '(comps: (000040 091207) (014580 091208))
(scheme (cond ((assoc 'scheme: rest-of) => cdr) (else #f)))
(indentries (cond ((assoc 'indentries: rest-of) => cdr) (else (list))))
(check-only? (or check-only? (assoc 'check-only! rest-of)))
(check-upto-n (cond ((assoc 'upto: rest-of) => cadr) (else check-upto-n)))
(Astr (Anum->str Anum))
(Afun (Anum->Afun Anum))
(Ainvstr (and Ainv (Anum->str Ainv)))
(Ainvfun (and Ainv (Anum->Afun Ainv)))
(base-seq (map (lambda (n) (+ n off)) (iota0 (- check-upto-n off))))
(Aseq (map Afun base-seq))
(negative-terms? (there-exists? Aseq negative?))
(one-based-pos-of-first-term-gte-2
(cond ((pos-of-first-matching Aseq (lambda (x) (>= (abs x) 2))) => 1+)
(else 1) ;; If no terms other than 0,1 or -1, then use 1 as the second elem of offset pair.
)
)
(more-than-one-zero? (cond ((and Ainvfun (memq 0 Aseq)) => (lambda (r) (memq 0 (cdr r)))) (else #f)))
;; (no-larger-than-abs-1-terms? (for-all? Aseq (lambda (n) (< (abs n) 2)))) ;; Not needed.
(Y-line-started? #f) ;; Not yet.
)
(cond (Ainvfun
;; If Aseq has more than one 0, then the given inverse function is non-surjective injection from N to N,
;; and we have to check Afun(Ainvfun(x)), and otherwise Ainvfun(Afun(x)):
(cond (more-than-one-zero?
(let ((Ainvseq (map Ainvfun base-seq)))
(cond ((not (equal? (map Afun Ainvseq) base-seq))
(format outport "!!! This function ~A IS NOT an inverse function of injection ~A (checked up to n=~A).\n"
Astr Ainvstr
)
)
(check-only?
(format outport "Yes, this function ~A seems to be an inverse function of non-surjective injection ~A (checked up to n=~A).\n"
Astr Ainvstr check-upto-n
)
)
)
) ;; let
)
((not (equal? (map Ainvfun Aseq) base-seq))
(format outport "!!! The inverse ~A for ~A is not correct\n"
Ainvstr Astr
)
)
(check-only?
(format outport "Yes, function ~A seems to be an inverse of ~A when computed up to n=~A\n"
Ainvstr Astr check-upto-n
)
)
)
)
)
(cond (comps
(for-each (lambda (comp)
(check-composition outport comp base-seq Aseq Astr check-only?)
)
comps
)
)
)
(cond (check-only?
(html-out-sequence-A-link Anum outport)
(format outport " = \n")
(html-out-sequence-search-link outport Aseq seek-len)
)
(else
(format outport "%I ~A\n" Astr)
(let* ((max-term-line-len 69) ;; As (string-length "%S A012345") = 10.
(part1len (len-of-max-full-line-prefix Aseq max-term-line-len))
(part2len (len-of-max-full-line-prefix (list-tail Aseq part1len) max-term-line-len)) ;; Could be zero!
(part3len (len-of-max-full-line-prefix (list-tail Aseq (+ part1len part2len)) max-term-line-len)) ;; Could be zero!
(part1 (sublist Aseq 0 part1len))
(part2 (sublist Aseq part1len (+ part1len part2len))) ;; results () if part2len = 0.
(part3 (sublist Aseq (+ part1len part2len) (+ part1len part2len part3len))) ;; results () if part2len = 0 or part3len = 0.
)
(with-output-to-port outport
(lambda ()
(format outport "%S ~A " Astr) (output_seq (map abs part1)) (format outport ",\n")
(cond ((pair? part2)
(format outport "%T ~A " Astr) (output_seq (map abs part2)) (format outport ",\n")
)
)
(cond ((pair? part3)
(format outport "%U ~A " Astr) (output_seq (map abs part3)) (newline outport)
)
)
(cond (negative-terms?
(format outport "%V ~A " Astr) (output_seq part1) (format outport ",\n")
(cond ((pair? part2)
(format outport "%W ~A " Astr) (output_seq part2) (format outport ",\n")
)
)
(cond ((pair? part3)
(format outport "%X ~A " Astr) (output_seq part3) (newline outport)
)
)
)
)
)
)
) ;; let*
(format outport "%N ~A ~A\n" Astr name)
(cond (f
(format outport "%F ~A ~A\n" Astr f)
)
)
(cond (c
(format outport "%C ~A ~A\n" Astr C)
)
)
(cond (e
(format outport "%e ~A ~A\n" Astr e)
)
)
(format outport "%H ~A A. Karttunen, Scheme-program for computing this sequence.\n"
Astr
)
(cond
((pair? indentries)
(cond ((memq 'GF2X indentries)
(format outport "%H ~A Index entries for sequences operating on GF(2)[X]-polynomials\n"
Astr
)
)
)
(cond ((memq 'crossdomain indentries)
(format outport "%H ~A Index entries for sequences defined by congruent products between domains N and GF(2)[X]\n"
Astr
)
)
)
(cond ((memq 'XORcongruent indentries)
(format outport "%H ~A Index entries for sequences defined by congruent products under XOR\n"
Astr
)
)
)
(cond ((memq 'Lattices indentries)
(format outport "%H ~A Index entries for sequences related to Lattices\n"
Astr
)
)
)
(cond ((memq 'Nperm indentries)
(format outport "%H ~A Index entries for sequences that are permutations of the natural numbers\n"
Astr
)
)
)
(cond ((memq 'Catsigperm indentries)
(format outport "%H ~A Index entries for signature-permutations of Catalan automorphisms\n"
Astr
)
)
)
)
)
(cond (Ainv
(cond ((not Y-line-started?)
(format outport "%Y ~A" Astr)
(set! Y-line-started? #t)
)
)
(cond (more-than-one-zero?
(format outport " Inverse of ~A." Ainvstr)
)
(else
(format outport " Inverse: ~A." Ainvstr)
)
)
)
)
;; We should also check them, but can't do this with just A-numbers, as
;; we need the function definitions. (Here the old-fashioned Lisp would beat Scheme.)
(cond (comps
(cond ((not Y-line-started?)
(format outport "%Y ~A" Astr)
(set! Y-line-started? #t)
)
)
(format outport " a(n)")
(for-each (lambda (comp)
(format outport " = ~A" (complist->exprstr comp))
)
comps
)
(format outport ".")
)
)
(cond (y
(cond ((not Y-line-started?)
(format outport "%Y ~A" Astr)
(set! Y-line-started? #t)
)
)
(format outport " ~A" y)
)
)
(if Y-line-started? (newline outport))
(format outport "%K ~A ~A~A\n"
Astr (if negative-terms? "sign" "nonn")
(if keywords (string-append "," keywords) "")
)
(format outport "%O ~A ~A,~A\n"
Astr off one-based-pos-of-first-term-gte-2
)
(format outport "%A ~A Antti Karttunen (His-Firstname.His-Surname(AT)gmail.com), ~A\n"
Astr subm-date
)
(cond (scheme
(format outport "%o ~A (MIT Scheme:)\n" Astr)
(for-each (lambda (schemedef) (format outport "%o ~A ~A\n" Astr schemedef)) scheme)
)
)
(newline outport)
) ;; else
) ;; cond
) ;; let*
)