/*****************************************************************************/
/* http://www.research.att.com/~njas/sequences/gatomorf.c.txt */
/* */
/* gatomorf.c -- A lean and fast C-program to compute empirically */
/* the cycle counts of various gatomorphisms */
/* found in Neil J.A. Sloane's Online-Encyclopedia */
/* of Integer Sequences at: */
/* http://www.research.att.com/~njas/sequences/ */
/* */
/* Coded 2003 by Antti Karttunen, http://www.iki.fi/~kartturi/ */
/* and placed in Public Domain. */
/* Last edited 20. Dec 2003. */
/* For the absolutely freshest version, see also the copy at: */
/* http://www.iki.fi/~kartturi/matikka/Nekomorphisms/gatomorf.c */
/* */
/* Feel free to add more implementations of gatomorphisms here, */
/* by implementing the corresponding bijective function(s), */
/* and then adding it with proper sequence numbers to */
/* struct t_gatom_descr Gatomorphisms[] */
/* */
/* You can then mail the improved source either to me */
/* in address Antti.Karttunen (at) iki.fi */
/* or to Neil Sloane in address njas (at) research.att.com */
/* */
/* A 64-bit architecture is preferable to run the program. */
/* This has been tested in SunOS 5.8 and Alpha with OpenVMS. */
/* Even 32-bit Intel is fine for most cases if it is fast. */
/* */
/* For the essence of this program, see routine CountCycles. */
/* */
/* Note that the largest continuous chunk of RAM one can allocate */
/* (with calloc) is essentially the limiting factor for how long one */
/* can compute these sequences. */
/* E.g. to continue to the size n=21, for which A000108(21)=24,466,267,020 */
/* divided by 8 is 3,058,283,378 i.e. almost 3 gigabytes of available */
/* memory would be needed. */
/* For the size n=22, we have A000108(22)= 91,482,563,640 */
/* which divided by 8 is 11,435,320,455 which is over 4,294,967,296 (2^32) */
/* so not only the huge amount of memory would be needed, but also */
/* larger pointers than just 32-bits wide. */
/* */
/* For real 64-bit Suns, compile with: */
/* cc -DREQUIRES_LONG_LONG -xO4 -fast -o gatomorf gatomorf.c -xtarget=ultra -xchip=ultra -xarch=v9
/* */
/* To count LCM's for gatomorphisms like A057505 where */
/* an overflow >= 2^64 soon occurs, it helps to run this like: */
/* ./gatomorf 57505 18 -l | sort | uniq */
/* before feeding the lists to a appropriate Lisp-system with */
/* unlimited integer precision. */
/* */
/* To get only the odd cycles use: */
/* ./gatomorf 57505 18 -l | grep -v '[02468]$' */
/* */
/* Add option -M for Maple-suitable output: */
/* ./gatomorf 57505 18 -l -M | sort | uniq */
/* */
/* For Mathematica, do the same, but with extra filters: */
/* ./gatomorf 57505 18 -l -M | sort | uniq | tr "\[\]" "{}" | fgrep -v "#" */
/* */
/* For the Scheme implementation of many of the same gatomorphisms, see: */
/* http://www.iki.fi/~kartturi/matikka/Nekomorphisms/gatomorf.htm */
/* */
/*****************************************************************************/
#include "stdio.h"
/* With our 64 bits MAXSIZE is 31, with 32 bit machines it's only 15.
(because we need one extra bit for the last leaf of binary trees) */
#ifdef ONLY32BITS
#define MAXSIZE 21
#define MAXSIZE_FOR_TBBS 15
#else
#define MAXSIZE 31
#define MAXSIZE_FOR_TBBS 31
#endif
typedef unsigned char BYTE;
typedef unsigned long int ULI;
#define FILLED_BYTE ((BYTE)((~((BYTE) 0))))
#ifdef REQUIRES_LONG_LONG
typedef unsigned long long int ULLI; /* Two longs on 64-bit Suns */
typedef long long int SLLI; /* Ditto. */
#else /* We are running on Alpha, or maybe some small 32-bit machine. */
typedef unsigned long int ULLI; /* Only one long on DEC Alpha's */
typedef long int SLLI; /* Ditto. */
#endif
typedef ULLI TBBS; /* TBBS = totally balanced binary sequence. With 32 bits only upto size n=15, with 64 upto n=31. */
typedef SLLI RANK; /* With 32 bits we can go upto size n=19, with 64 much further. */
typedef int SIZE;
/**********************************************************************/
/* */
/* Added 14. Oct 2003: SEXP-structure (a simple planar binary tree) */
/* because most of the gatomorphisms are easier to define in such */
/* Lisp-like terms, than to work directly on the binary sequences. */
/* */
/**********************************************************************/
struct s_exp
{
struct s_exp *s_car; /* I.e. the left branch of the binary tree. */
struct s_exp *s_cdr; /* I.e. the right branch of the ---- "" ---- */
};
typedef struct s_exp SEXP_cell;
typedef SEXP_cell *SEXP;
#define NULLP(s) ((s) == NULL)
#define PAIR(s) (!NULLP(s))
#define CAR(s) ((s)->s_car)
#define CDR(s) ((s)->s_cdr)
#define SET_CAR(s,x) (((s)->s_car) = x)
#define SET_CDR(s,x) (((s)->s_cdr) = x)
SEXP cons(SEXP carside,SEXP cdrside)
{
SEXP newcell = ((SEXP) calloc(1,sizeof(SEXP_cell)));
if(NULL == newcell)
{
fprintf(stderr,
"cons: Couldn't allocate a chunk of %u bytes to store one cons cell!\n",
sizeof(SEXP_cell));
exit(1);
}
/* fflush(stdout); fprintf(stderr,"cons called!\n"); fflush(stderr); */
SET_CAR(newcell,carside);
SET_CDR(newcell,cdrside);
return(newcell);
}
/* Taking plunge on car-side, find the first cons-cell
with either its CAR or CDR-side NULL,
and return that cell as a result,
to be reused by recons
*/
SEXP degraft(SEXP *subroot)
{
SEXP z;
if(NULLP(CAR(*subroot)))
{
z = *subroot;
*subroot = CDR(z);
return(z);
}
if(NULLP(CDR(*subroot)))
{
z = *subroot;
*subroot = CAR(z);
return(z);
}
return(degraft(&(CAR(*subroot))));
}
/* Here an all-out (not incremental like here!) deconstruction of
the previous S-expression to a separate free-list
(which just means flattening it!)
might be faster on larger S-expressions:
*/
SEXP recons(SEXP carside,SEXP cdrside,SEXP *reused)
{
if(NULLP(*reused)) { return(cons(carside,cdrside)); }
else
{
SEXP z = degraft(reused);
SET_CAR(z,carside);
SET_CDR(z,cdrside);
return(z);
}
}
/* Recursively free the tree allocated with cons. */
void free_cons_tree(SEXP node)
{
if(NULLP(node)) { return; }
if(!NULLP(CAR(node))) { free_cons_tree(CAR(node)); }
if(!NULLP(CDR(node))) { free_cons_tree(CDR(node)); }
free(node);
}
/**********************************************************************/
/* Pointer to function that accepts a TBBS and returns TBBS
(for implementations that work on totally balanced binary strings,
not S-expressions).
*/
typedef TBBS (*PFGM_TBBS)(TBBS);
/* Pointer to function that accepts a SEXP and returns nothing
(for destructive implementations that work on S-expressions).
*/
typedef void (*PFGM_SEXP)(SEXP);
#define NULLGMT ((PFGM_TBBS)0)
#define NULLGMS ((PFGM_SEXP)0)
#define WHICHEVER 0
#define FORCE_SEXP 1
#define FORCE_TBBS 2
#define LONG_ONE ((ULLI) 1)
#define two_to(n) (LONG_ONE << (n))
#define RECURSION_SCHEMA_0(A,B)\
void A (SEXP s) { if(PAIR(s)) { B (s); A (CAR(s)); A (CDR(s)); } }
#define RECURSION_SCHEMA_1(A,B)\
void A (SEXP s) { if(PAIR(s)) { A (CAR(s)); A (CDR(s)); B (s); } }
#define RECURSION_SCHEMA_2(A,B)\
void A (SEXP s) { if(PAIR(s)) { B (s); A (CDR(s)); } }
#define RECURSION_SCHEMA_3(A,B)\
void A (SEXP s) { if(PAIR(s)) { A (CDR(s)); B (s); } }
#define RECURSION_SCHEMA_M(A,B)\
void A (SEXP s) { if(PAIR(s)) { B (CAR(s)); A (CDR(s)); } }
#define APPLY_TO_LEFT_SIDE(A,B)\
void A (SEXP s) { if(PAIR(s)) { B (CAR(s)); } }
#define COMPOSITION_OF(A,B,C) void A (SEXP s) { C (s); B (s); }
TBBS gmt_A001477(TBBS a) { return(a); }
TBBS gmt_A057117(TBBS a);
TBBS gmt_A057163(TBBS a);
TBBS gmt_A057164(TBBS a);
TBBS gmt_A057505(TBBS a) { return(gmt_A057164(gmt_A057163(a))); }
TBBS gmt_A057506(TBBS a) { return(gmt_A057163(gmt_A057164(a))); }
TBBS gmt_A071661(TBBS a) { return(gmt_A057505(gmt_A057505(a))); }
TBBS gmt_A071662(TBBS a) { return(gmt_A057506(gmt_A057506(a))); }
TBBS gmt_A071663(TBBS a) { return(gmt_A057505(gmt_A071661(a))); }
TBBS gmt_A071664(TBBS a) { return(gmt_A057506(gmt_A071662(a))); }
TBBS gmt_A071665(TBBS a) { return(gmt_A071661(gmt_A071661(a))); }
TBBS gmt_A071666(TBBS a) { return(gmt_A071662(gmt_A071662(a))); }
TBBS gmt_A071667(TBBS a) { return(gmt_A057505(gmt_A071665(a))); }
TBBS gmt_A071668(TBBS a) { return(gmt_A057506(gmt_A071666(a))); }
TBBS gmt_A071669(TBBS a) { return(gmt_A071663(gmt_A071663(a))); }
TBBS gmt_A071670(TBBS a) { return(gmt_A071664(gmt_A071664(a))); }
void gms_A001477(SEXP s) { }
void gms_A069770(SEXP s);
void gms_A072796(SEXP s);
void gms_A072797(SEXP s);
void gms_A074679(SEXP s);
void gms_A074680(SEXP s);
void gms_A082351(SEXP s);
void gms_A082352(SEXP s);
void gms_A089850(SEXP s);
void gms_A089851(SEXP s);
void gms_A089852(SEXP s);
void gms_A089853(SEXP s);
void gms_A089854(SEXP s);
void gms_A089855(SEXP s);
void gms_A089856(SEXP s);
void gms_A089857(SEXP s);
COMPOSITION_OF(gms_A074679v2,gms_A069770,gms_A089853) /* 1 o 6 = 12. */
COMPOSITION_OF(gms_A089858,gms_A069770,gms_A089852) /* 1 o 5 = 13. */
COMPOSITION_OF(gms_A073269,gms_A069770,gms_A072796) /* 1 o 2 = 14. */
COMPOSITION_OF(gms_A089859,gms_A069770,gms_A089850) /* 1 o 3 = 15. */
COMPOSITION_OF(gms_A089860,gms_A069770,gms_A089851) /* 1 o 4 = 16. */
COMPOSITION_OF(gms_A074680v2,gms_A069770,gms_A089855) /* 1 o 9 = 17. */
COMPOSITION_OF(gms_A089861,gms_A069770,gms_A072797) /* 1 o 8 = 18. */
COMPOSITION_OF(gms_A073270,gms_A069770,gms_A089856) /* 1 o 10 = 19. */
COMPOSITION_OF(gms_A089862,gms_A069770,gms_A089857) /* 1 o 11 = 20. */
COMPOSITION_OF(gms_A089863,gms_A069770,gms_A089854) /* 1 o 7 = 21. */
COMPOSITION_OF(gms_A089864,gms_A089863,gms_A089863)
APPLY_TO_LEFT_SIDE(gms_A089865,gms_A074679)
APPLY_TO_LEFT_SIDE(gms_A089866,gms_A074680)
void gms_A071655(SEXP s);
void gms_A071656(SEXP s);
void gms_A071659(SEXP s);
void gms_A071660(SEXP s);
void gms_A082335(SEXP s);
void gms_A082336(SEXP s);
void gms_A082349(SEXP s);
void gms_A082350(SEXP s);
/* Gatomorphisms based on A069770 (swap sides) */
RECURSION_SCHEMA_0(gms_A057163,gms_A069770)
RECURSION_SCHEMA_2(gms_A069767,gms_A069770)
RECURSION_SCHEMA_3(gms_A069768,gms_A069770)
COMPOSITION_OF(gms_A073286,gms_A069770,gms_A069767)
COMPOSITION_OF(gms_A073287,gms_A069768,gms_A069770)
/* These correspondences explain why A073288/9 has A023359
as its fix count sequence:
Similarly, when we do (map foo! s) with any gatomorphism
that has A019590 as its fix count sequence (i.e. that fixes
only () and (()) ) then we obtain A000045, the Fibonacci numbers.
*/
RECURSION_SCHEMA_2(gms_A073288,gms_A073286) /* RECURSION_SCHEMA_M(gms_A073288,gms_A069767); } */
RECURSION_SCHEMA_3(gms_A073289,gms_A073287) /* RECURSION_SCHEMA_M(gms_A073289,gms_A069768); } */
RECURSION_SCHEMA_2(gms_A082345,gms_A069767)
RECURSION_SCHEMA_3(gms_A082346,gms_A069768)
RECURSION_SCHEMA_2(gms_A082347,gms_A069768)
RECURSION_SCHEMA_3(gms_A082348,gms_A069767)
/* Gatomorphisms based on A072796 (exchange the two leftmost branches) */
RECURSION_SCHEMA_0(gms_A057511,gms_A072796)
RECURSION_SCHEMA_1(gms_A057512,gms_A072796)
RECURSION_SCHEMA_2(gms_A057509,gms_A072796)
RECURSION_SCHEMA_3(gms_A057510,gms_A072796)
RECURSION_SCHEMA_1(gms_A057164,gms_A057509)
RECURSION_SCHEMA_2(gms_A057508,gms_A057510)
/* RECURSION_SCHEMA_3(gms_A057508,gms_A057509); */
/* Gatomorphisms based on A072797 (A057163-conjugate of A072796) */
RECURSION_SCHEMA_2(gms_A082339,gms_A072797)
RECURSION_SCHEMA_3(gms_A082340,gms_A072797)
RECURSION_SCHEMA_0(gms_A074681,gms_A074679)
RECURSION_SCHEMA_1(gms_A074682,gms_A074680)
RECURSION_SCHEMA_1(gms_A074683,gms_A074679)
RECURSION_SCHEMA_0(gms_A074684,gms_A074680)
RECURSION_SCHEMA_2(gms_A074685,gms_A074679)
RECURSION_SCHEMA_3(gms_A074686,gms_A074680)
RECURSION_SCHEMA_M(gms_A085169,gms_A074684)
RECURSION_SCHEMA_M(gms_A085170,gms_A074683)
APPLY_TO_LEFT_SIDE(gms_A089867,gms_A085169)
APPLY_TO_LEFT_SIDE(gms_A089868,gms_A085170)
RECURSION_SCHEMA_M(gms_A089869,gms_A085169)
RECURSION_SCHEMA_M(gms_A089870,gms_A085170)
RECURSION_SCHEMA_2(gms_A057501,gms_A074680)
RECURSION_SCHEMA_3(gms_A057502,gms_A074679)
RECURSION_SCHEMA_0(gms_A057506,gms_A057502)
RECURSION_SCHEMA_1(gms_A057505,gms_A057501)
RECURSION_SCHEMA_2(gms_A057504,gms_A057502)
RECURSION_SCHEMA_3(gms_A057503,gms_A057501)
/* Gatomorphisms based on A082351 & A082352. */
RECURSION_SCHEMA_1(gms_A082355,gms_A082351)
RECURSION_SCHEMA_0(gms_A082356,gms_A082352)
COMPOSITION_OF(gms_A057161,gms_A057508,gms_A069767)
COMPOSITION_OF(gms_A057162,gms_A069768,gms_A057508)
COMPOSITION_OF(gms_A069888,gms_A057501,gms_A057164)
COMPOSITION_OF(gms_A082313,gms_A069888,gms_A057502)
COMPOSITION_OF(gms_A082333,gms_A057163,gms_A082313)
COMPOSITION_OF(gms_A082334,gms_A082313,gms_A057163)
COMPOSITION_OF(gms_A082315,gms_A057501,gms_A057501)
COMPOSITION_OF(gms_A082316,gms_A057502,gms_A057502)
void gms_A069771(SEXP s);
COMPOSITION_OF(gms_A069772,gms_A057164,gms_A069771)
COMPOSITION_OF(gms_Anew1,gms_A074684,gms_A057164) /* Allocate A-numbers for */
COMPOSITION_OF(gms_Anew2,gms_A057164,gms_A074683) /* these, later. */
COMPOSITION_OF(gms_A085161,gms_Anew1,gms_A074683) /* A085161 = (74684 57164 74683) */
COMPOSITION_OF(gms_A085163,gms_A085161,gms_A057508)
COMPOSITION_OF(gms_A085164,gms_A057508,gms_A085161)
struct t_gatom_descr
{
int gato_num1;
int gato_num2; /* A-num of the inverse, equal to gato_num1 if involution. */
const char *gato_description;
PFGM_TBBS gato_tbbsfun1;
PFGM_TBBS gato_tbbsfun2; /* Inverse of gato_tbbsfun1, equal if involution */
PFGM_SEXP gato_sexpfun1;
PFGM_SEXP gato_sexpfun2; /* Inverse of gato_sexpfun1, equal if involution */
int gato_ccs;
int gato_fix;
int gato_max;
int gato_lcm;
};
/* Pointer to function that outputs some information about gato_descriptor: */
typedef void (*PF_GATO_OUT)(FILE *,int,struct t_gatom_descr *);
typedef int (*PF_VEC_OUT)(FILE *,ULLI *,int,int);
/* Numbers here stand for A-numbers used in
Neil Sloane's Online-Encyclopedia of Integer Sequences.
E.g. 45 is for A000045, the Fibonacci numbers.
0s stand for those sequences have not yet been
submitted into OEIS (or I haven't found them), or which
I don't care to submit.
Note: A084100 (in its unsigned manifestation)
might be better than A046698 to indicate
the MAX and LCM sequences of the involutions: 1,1,2,2,2,2,2,2,2,...
*/
struct t_gatom_descr Gatomorphisms[] =
{ /* Asigperm1, Asigperm2, description
CCs FIX MAX LCM */
{ 1477, 1477, "A089840[0]: Identity.",
gmt_A001477, gmt_A001477, gms_A001477, gms_A001477,
108, 108, 12, 12 },
{ 69770, 69770, "A089840[1]: Swap the left and right subtree of a binary tree",
NULLGMT, NULLGMT, gms_A069770, gms_A069770,
7595, 108, 46698, 46698 },
{ 72796, 72796, "A089840[2]: Exchange the two leftmost branches of a general tree if its degree > 1",
NULLGMT, NULLGMT, gms_A072796, gms_A072796,
73191, 73190, 46698, 46698 },
{ 89850, 89850, "A089840[3]: Swap cadr and cddr of an S-exp if its length > 1",
NULLGMT, NULLGMT, gms_A089850, gms_A089850,
73191, 73190, 46698, 46698 },
{ 89851, 89853, "A089840[4]/[6]: Rotate car, cadr and cddr of an S-exp if its length > 1",
NULLGMT, NULLGMT, gms_A089851, gms_A089853,
89847, 89848, 0, 0 },
{ 89852, 89852, "A089840[5]: Swap car and cddr of an S-exp if its length > 1",
NULLGMT, NULLGMT, gms_A089852, gms_A089852,
73191, 73190, 46698, 46698 },
{ 89854, 89854, "A089840[7]: Swap caar and cdar of an S-exp if possible. (A057163-conjugate of A089850)",
NULLGMT, NULLGMT, gms_A089854, gms_A089854,
73191, 73190, 46698, 46698 },
{ 72797, 72797, "A089840[8]: A057163-conjugate of A072796",
NULLGMT, NULLGMT, gms_A072797, gms_A072797,
73191, 73190, 46698, 46698 },
{ 89855, 89857, "A089840[9]/[11]: Rotate caar, cdar and cdr of an S-exp if possible",
NULLGMT, NULLGMT, gms_A089855, gms_A089857,
89847, 89848, 0, 0 },
{ 89856, 89856, "A089840[10]: Swap caar and cdr of an S-exp if possible. (A057163-conjugate of A089852)",
NULLGMT, NULLGMT, gms_A089856, gms_A089856,
73191, 73190, 46698, 46698 },
{ 74679, 74680, "A089840[12]/[17]: Rotate a binary tree, if possible, otherwise swap its sides",
NULLGMT, NULLGMT, gms_A074679, gms_A074680,
1683, 19590, 89410, 89410 },
{ 89858, 89861, "A089840[13]/[18]: Gatomorphism A089858/A089861",
NULLGMT, NULLGMT, gms_A089858, gms_A089861,
/* CHECK */ 73193, 19590, 89422, 89423 },
{ 73269, 73270, "A089840[14]/[19]: Gatomorphism A073269/A073270",
NULLGMT, NULLGMT, gms_A073269, gms_A073270,
73193, 19590, 89422, 89423 },
{ 89859, 89863, "A089840[15]/[21]: Gatomorphism A089859/A089863",
NULLGMT, NULLGMT, gms_A089859, gms_A089863,
89407, 0, 40002, 40002 }, /* Shift A040002 RIGHT twice (prepending 1).
FIXcounts are 1,1,0,1,0,0,0,1,0,0,0,2,0,0,0,5,0,0,0,14,0,... i.e. A000108 aerated twice. */
{ 89860, 89862, "A089840[16]/[20]: Gatomorphism A089859/A089862",
NULLGMT, NULLGMT, gms_A089860, gms_A089862,
1683, 19590, 89410, 89410 },
{ 89865, 89866, "A089840[4207]/[4299]: Apply A074769/A074680 to the left subtree",
NULLGMT, NULLGMT, gms_A089865, gms_A089866,
89844, 5807, 89410, 89845 }, /* The max-count seq is actually RIGHT(A089410). The fix counts = 1,1,Cat(n-1)+Cat(n) */
{ 82351, 82352, "A089840[4069]/[4253]: Non-recursive gatomorphism: A082351/A082352",
NULLGMT, NULLGMT, gms_A082351, gms_A082352,
89424, 108, 89425, 89425 },
{ 89864, 89864, "A089840[1654694]: Gatomorphism A089864. (A089859 or A089863 squared)",
NULLGMT, NULLGMT, gms_A089864, gms_A089864,
89402, 89408, 46698, 46698 },
{ 57117, 57118, "Meeussen's bf<->df conversion on a binary tree",
gmt_A057117, NULLGMT, NULLGMS, NULLGMS,
38775, 0, 57542, 60113 }, /* FIX-count sequence begins as 1,1,2,2,2,2,2,2,2,2,3,3,3,3,3,3,3,3,3,3,3 */
{ 57163, 57163, "Reflect a rooted plane binary tree",
gmt_A057163, gmt_A057163, gms_A057163, gms_A057163,
7595, 108, 46698, 46698 },
{ 57164, 57164, "Reflect a rooted plane general tree (Deep Reverse parenthesization)",
gmt_A057164, gmt_A057164, gms_A057164, gms_A057164,
7123, 1405, 46698, 46698 },
{ 57508, 57508, "Shallow Reverse parenthesization",
NULLGMT, NULLGMT, gms_A057508, gms_A057508,
73193, 73192, 46698, 46698 },
{ 57501, 57502, "Rotate a non-crossing chords arrangement; Rotate the root position of a general tree",
NULLGMT, NULLGMT, gms_A057501, gms_A057502,
2995, 19590, 57543, 57543 /* essentially */ },
{ 82315, 82316, "Rotate twice a non-crossing chords arrangement",
NULLGMT, NULLGMT, gms_A082315, gms_A082316,
54357, 46698, 65475, 65475 },
{ 69771, 69771, "Rotate non-crossing chords arrangement by 180 degrees",
NULLGMT, NULLGMT, gms_A069771, gms_A069771,
7123, 1405, 46698, 46698 },
{ 69772, 69772, "Reflect non-crossing chords arrangement by X-axis",
NULLGMT, NULLGMT, gms_A069772, gms_A069772,
89880, 89849, 46698, 46698 },
{ 57503, 57504, "Gatomorphism A057503/A057504",
NULLGMT, NULLGMT, gms_A057503, gms_A057504,
1683, 19590, 57544, 57544 },
{ 57505, 57506, "Donaghey's Map M (composition of involutions A057163 and A057164)",
gmt_A057505, gmt_A057506, gms_A057505, gms_A057506,
57507, 19590, 57545, 60114 },
{ 71661, 71662, "Donaghey's Map M^2",
gmt_A071661, gmt_A071662, NULLGMS, NULLGMS,
79437, 79438, 79439, 89403 },
{ 71663, 71664, "Donaghey's Map M^3",
gmt_A071663, gmt_A071664, NULLGMS, NULLGMS,
79441, 79442, 79443, 89871 },
{ 71665, 71666, "Donaghey's Map M^4",
gmt_A071665, gmt_A071666, NULLGMS, NULLGMS,
89872, 89873, 89874, 89875 },
{ 71667, 71668, "Donaghey's Map M^5",
gmt_A071667, gmt_A071668, NULLGMS, NULLGMS,
89876, 89877, 89878, 89879 },
{ 71669, 71670, "Donaghey's Map M^6",
gmt_A071669, gmt_A071670, NULLGMS, NULLGMS,
0, 0, 0, 0 },
{ 57509, 57510, "Rotate top-level of a parenthesizations (Shallow Rotate)",
NULLGMT, NULLGMT, gms_A057509, gms_A057510,
3239, 34731, 28310, 3418 },
{ 57511, 57512, "Rotate all levels of a parenthesization (Deep Rotate)",
NULLGMT, NULLGMT, gms_A057511, gms_A057512,
57513, 57546, 793, 3418 },
{ 69767, 69768, "Swap recursively the other side of binary tree",
NULLGMT, NULLGMT, gms_A069767, gms_A069768,
73431, 36987, 11782, 11782 },
{ 73286, 73287, "Swap recursively the other side of binary tree, but excluding the root node",
NULLGMT, NULLGMT, gms_A073286, gms_A073287,
89404, 73268, 11782, 11782 },
{ 73288, 73289, "Apply A069767/A069768 to each toplevel subtree",
NULLGMT, NULLGMT, gms_A073288, gms_A073289,
89405, 23359, 11782, 11782 },
{ 82345, 82346, "Gatomorphisms A082345/A082346: Apply A069767/A069768 in recursion schemes 2 & 3",
NULLGMT, NULLGMT, gms_A082345, gms_A082346,
89406, 0, 0, 0 }, /* FIX-point sequence begins as 1,1,0,1,0,2,0,3,0,6,0,10,0,18,0,31,0,56,0,98,0
whose bisection (the odd-positioned terms) appears to be A023359 (to be proved). */
/* The Max. & LCM-sequences begin as 1,1,2,2,4,8,16,32,64,128,256,512,1024,2048,...
i.e. they are almost same as A011782, but with an extra 2 inserted between. */
{ 82347, 82348, "Gatomorphisms A082347/A082348: Apply A069768/A069767 in recursion schemes 2 & 3",
NULLGMT, NULLGMT, gms_A082347, gms_A082348,
89406, 0, 0, 0 },
{ 57161, 57162, "Rotate a polygon triangulation",
NULLGMT, NULLGMT, gms_A057161, gms_A057162,
1683, 19590, 57544, 57544 },
{ 74681, 74682, "Gatomorphism A074681/A074682", /* Conjugate of the next one. */
NULLGMT, NULLGMT, gms_A074681, gms_A074682,
89411, 19590, 86586, 89412 }, /* 2 NEW CHEK 86586*/
{ 74683, 74684, "Gatomorphism A074683/A074684 (Few orbits, non-monotone)",
NULLGMT, NULLGMT, gms_A074683, gms_A074684,
89411, 19590, 86586, 89412 }, /* SAME AS ABOVE. */
{ 71655, 71656, "Gatomorphism A071655/A071656",
NULLGMT, NULLGMT, gms_A071655, gms_A071656,
89413, 19590, 89414, 89415 },
{ 71659, 71660, "Gatomorphism A071659/A071660",
NULLGMT, NULLGMT, gms_A071659, gms_A071660,
89413, 19590, 89414, 89415 }, /* SAME AS ABOVE. */
{ 69888, 69888, "Reflect non-crossing chords by the axis through corners (A057501 o A057164)",
NULLGMT, NULLGMT, gms_A069888, gms_A069888,
7595, 108, 46698, 46698 },
{ 82313, 82313, "Meeussen's skew catacycles (A069888 o A057502)",
NULLGMT, NULLGMT, gms_A082313, gms_A082313,
7123, 1405, 46698, 46698 },
{ 82333, 82334, "Composition of involutions A057163 & A082313 (Largish orbits, with a non-monotone notch)",
NULLGMT, NULLGMT, gms_A082333, gms_A082334,
89417, 89418, 89419, 89420 },
{ 85163, 85164, "Gatomorphism A085163/A085164",
NULLGMT, NULLGMT, gms_A085163, gms_A085164,
90828, 51920, 90829, 90830 },
{ 85169, 85170, "Apply A074684/A074683 to each toplevel subtree",
NULLGMT, NULLGMT, gms_A085169, gms_A085170,
86585, 45, 86586, 86587 },
{ 89867, 89868, "Apply A085169/A085170 to the left subtree",
NULLGMT, NULLGMT, gms_A089867, gms_A089868,
89846, 90826, 86586, 86587 }, /* Check 86586 & 86587 here & below. (shifted right). */
{ 89869, 89870, "Apply A085169/A085170 to each toplevel subtree",
NULLGMT, NULLGMT, gms_A089869, gms_A089870,
90827, 129, 86586, 86587 }, /* Check that A000129 indeed in INVERT(A000045). */
{ 82335, 82336, "Rotate a binary tree, if possible, otherwise reflect it",
NULLGMT, NULLGMT, gms_A082335, gms_A082336,
89421, 19590, 89422, 89423 },
{ 82349, 82350, "Rotate a binary tree, if possible, otherwise apply gatomorphism A069767/A069768",
NULLGMT, NULLGMT, gms_A082349, gms_A082350,
73193, 19590, 89422, 89423 }, /* LAST TWO FROM ABOVE? */
{ 82355, 82356, "Gatomorphism A082355/A082356, Apply A082351/A082352 in recursion scheme 1 & 0",
NULLGMT, NULLGMT, gms_A082355, gms_A082356,
89426, 46698, 89427, 89428 },
{ 82339, 82340, "Gatomorphism A082339/A082440, Apply A072797 shallowly",
NULLGMT, NULLGMT, gms_A082339, gms_A082340,
89429, 89430, 16116, 16116 },
{ 0, 0, "The End Sentinel",
NULLGMT, NULLGMT, NULLGMS, NULLGMS,
0, 0, 0, 0 } /* FIN */
};
int globopt_output_cycle_lists = 0;
char *globopt_list_begin = "(";
char *globopt_list_delim = "";
char *globopt_list_end = ")";
char *globopt_elem_delim = "";
char *globopt_pair_begin = "(";
char *globopt_pair_delim = " ";
char *globopt_pair_end = ")";
char *globopt_comment_begin = ";;";
int globopt_HTML = 0;
int glob_which_one = 1;
int glob_which_implementation = WHICHEVER;
char *glob_author_info = "Antti Karttunen (His_Firstname.His_Surname(AT)iki.fi)";
char *glob_datestr = "Mon DD 20YY"; /* E.g. , Oct 28 2003 */
#ifdef ONLY32BITS
#define SS 20
#else
#define SS 33
#endif
RANK sA00108[SS] = {1, 1, 2, 5, 14, 42, 132, 429, 1430, 4862, 16796, 58786,
208012, 742900, 2674440, 9694845, 35357670, 129644790,
477638700, 1767263190 /* The last value < 2^32 at n=19 */
#ifndef ONLY32BITS
,6564120420, 24466267020, 91482563640, 343059613650,
1289904147324, 4861946401452, 18367353072152,
69533550916004, 263747951750360, 1002242216651368,
3814986502092304, 14544636039226909, 55534064877048198
#endif
};
#define Cat(n) (sA00108[n])
#define globrank(tree_size,lrank) ((0 == (tree_size)) ? 0 : A014137(tree_size-1)+(lrank))
/* The last value < 2^32 at n=19 */
RANK sA014137[SS] = {1, 2, 4, 9, 23, 65, 197, 626, 2056, 6918, 23714, 82500,
290512, 1033412, 3707852, 13402697, 48760367, 178405157,
656043857, ((RANK)2423307047)
#ifndef ONLY32BITS
,8987427467, 33453694487, 124936258127, 467995871777,
1757900019101, 6619846420553, 24987199492705,
94520750408709, 358268702159069, 1360510918810437,
5175497420902741, 19720133460129650, 75254198337177848
#endif
};
#define A014137(n) (sA014137[n])
/* Note: both rows and columns start from -1 */
/* Entry at CatTriangle(r,m) = CatTriangle(r,m-1) + CatTriangle(r-1,m) */
#define CatTriangle(r,c) (tA009766[(r+2)][(c+1)])
#ifdef ONLY32BITS
#define TR 21
#else
#define TR 34
#endif
RANK tA009766[][TR+1] = /* 34 rows in full version. */
{
{0},
{0, 0},
{0, 1, 0},
{0, 1, 1, 0},
{0, 1, 2, 2, 0},
{0, 1, 3, 5, 5, 0},
{0, 1, 4, 9, 14, 14, 0},
{0, 1, 5, 14, 28, 42, 42, 0},
{0, 1, 6, 20, 48, 90, 132, 132, 0},
{0, 1, 7, 27, 75, 165, 297, 429, 429, 0},
{0, 1, 8, 35, 110, 275, 572, 1001, 1430, 1430, 0},
{0, 1, 9, 44, 154, 429, 1001, 2002, 3432, 4862, 4862, 0},
{0, 1, 10, 54, 208, 637, 1638, 3640, 7072, 11934, 16796, 16796, 0},
{0, 1, 11, 65, 273, 910, 2548, 6188, 13260, 25194, 41990, 58786, 58786, 0},
{0, 1, 12, 77, 350, 1260, 3808, 9996, 23256, 48450, 90440, 149226, 208012,
208012, 0},
{0, 1, 13, 90, 440, 1700, 5508, 15504, 38760, 87210, 177650, 326876, 534888,
742900, 742900, 0},
{0, 1, 14, 104, 544, 2244, 7752, 23256, 62016, 149226, 326876, 653752,
1188640, 1931540, 2674440, 2674440, 0},
{0, 1, 15, 119, 663, 2907, 10659, 33915, 95931, 245157, 572033, 1225785,
2414425, 4345965, 7020405, 9694845, 9694845, 0},
{0, 1, 16, 135, 798, 3705, 14364, 48279, 144210, 389367, 961400, 2187185,
4601610, 8947575, 15967980, 25662825, 35357670, 35357670, 0},
{0, 1, 17, 152, 950, 4655, 19019, 67298, 211508, 600875, 1562275, 3749460,
8351070, 17298645, 33266625, 58929450, 94287120, 129644790, 129644790, 0},
{0, 1, 18, 170, 1120, 5775, 24794, 92092, 303600, 904475, 2466750, 6216210,
14567280, 31865925, 65132550, 124062000, 218349120, 347993910, 477638700,
477638700, 0},
{0, 1, 19, 189, 1309, 7084, 31878, 123970, 427570, 1332045, 3798795,
10015005, 24582285, 56448210, 121580760, 245642760, 463991880, 811985790,
1289624490, 1767263190, 1767263190, 0}
#ifndef ONLY32BITS
/* Then follows the first row with a value > 4294967295. */
,{0, 1, 20, 209, 1518, 8602, 40480, 164450, 592020, 1924065, 5722860,
15737865, 40320150, 96768360, 218349120, 463991880, 927983760, 1739969550,
3029594040, 4796857230, 6564120420, 6564120420, 0},
{0, 1, 21, 230, 1748, 10350, 50830, 215280, 807300, 2731365, 8454225,
24192090, 64512240, 161280600, 379629720, 843621600, 1771605360,
3511574910, 6541168950, 11338026180, 17902146600, 24466267020,
24466267020, 0},
{0, 1, 22, 252, 2000, 12350, 63180, 278460, 1085760, 3817125, 12271350,
36463440, 100975680, 262256280, 641886000, 1485507600, 3257112960,
6768687870, 13309856820, 24647883000, 42550029600, 67016296620,
91482563640, 91482563640, 0},
{0, 1, 23, 275, 2275, 14625, 77805, 356265, 1442025, 5259150, 17530500,
53993940, 154969620, 417225900, 1059111900, 2544619500, 5801732460,
12570420330, 25880277150, 50528160150, 93078189750, 160094486370,
251577050010, 343059613650, 343059613650, 0},
{0, 1, 24, 299, 2574, 17199, 95004, 451269, 1893294, 7152444, 24682944,
78676884, 233646504, 650872404, 1709984304, 4254603804, 10056336264,
22626756594, 48507033744, 99035193894, 192113383644, 352207870014,
603784920024, 946844533674, 1289904147324, 1289904147324, 0},
{0, 1, 25, 324, 2898, 20097, 115101, 566370, 2459664, 9612108, 34295052,
112971936, 346618440, 997490844, 2707475148, 6962078952, 17018415216,
39645171810, 88152205554, 187187399448, 379300783092, 731508653106,
1335293573130, 2282138106804, 3572042254128, 4861946401452,
4861946401452, 0},
{0, 1, 26, 350, 3248, 23345, 138446, 704816, 3164480, 12776588, 47071640,
160043576, 506662016, 1504152860, 4211628008, 11173706960, 28192122176,
67837293986, 155989499540, 343176898988, 722477682080, 1453986335186,
2789279908316, 5071418015120, 8643460269248, 13505406670700,
18367353072152, 18367353072152, 0},
{0, 1, 27, 377, 3625, 26970, 165416, 870232, 4034712, 16811300, 63882940,
223926516, 730588532, 2234741392, 6446369400, 17620076360, 45812198536,
113649492522, 269638992062, 612815891050, 1335293573130, 2789279908316,
5578559816632, 10649977831752, 19293438101000, 32798844771700,
51166197843852, 69533550916004, 69533550916004, 0},
{0, 1, 28, 405, 4030, 31000, 196416, 1066648, 5101360, 21912660, 85795600,
309722116, 1040310648, 3275052040, 9721421440, 27341497800, 73153696336,
186803188858, 456442180920, 1069258071970, 2404551645100, 5193831553416,
10772391370048, 21422369201800, 40715807302800, 73514652074500,
124680849918352, 194214400834356, 263747951750360, 263747951750360, 0},
{0, 1, 29, 434, 4464, 35464, 231880, 1298528, 6399888, 28312548, 114108148,
423830264, 1464140912, 4739192952, 14460614392, 41802112192, 114955808528,
301758997386, 758201178306, 1827459250276, 4232010895376, 9425842448792,
20198233818840, 41620603020640, 82336410323440, 155851062397940,
280531912316292, 474746313150648, 738494264901008, 1002242216651368,
1002242216651368, 0},
{0, 1, 30, 464, 4928, 40392, 272272, 1570800, 7970688, 36283236, 150391384,
574221648, 2038362560, 6777555512, 21238169904, 63040282096, 177996090624,
479755088010, 1237956266316, 3065415516592, 7297426411968, 16723268860760,
36921502679600, 78542105700240, 160878516023680, 316729578421620,
597261490737912, 1072007803888560, 1810502068789568, 2812744285440936,
3814986502092304, 3814986502092304, 0},
{0, 1, 31, 495, 5423, 45815, 318087, 1888887, 9859575, 46142811, 196534195,
770755843, 2809118403, 9586673915, 30824843819, 93865125915, 271861216539,
751616304549, 1989572570865, 5054988087457, 12352414499425, 29075683360185,
65997186039785, 144539291740025, 305417807763705, 622147386185325,
1219408876923237, 2291416680811797, 4101918749601365, 6914663035042301,
10729649537134605, 14544636039226909, 14544636039226909, 0},
{0, 1, 32, 527, 5950, 51765, 369852, 2258739, 12118314, 58261125, 254795320,
1025551163, 3834669566, 13421343481, 44246187300, 138111313215,
409972529754, 1161588834303, 3151161405168, 8206149492625, 20558563992050,
49634247352235, 115631433392020, 260170725132045, 565588532895750,
1187735919081075, 2407144796004312, 4698561476816109, 8800480226417474,
15715143261459775, 26444792798594380, 40989428837821289, 55534064877048198,
55534064877048198, 0}
#endif
};
/*
floor_log_2(55534064877048198); = 55
2^64; = 18446744073709551616
I.e. just a bit more than the distance to Deneb (Alpha Cygni) in *metres*.
*/
RANK CatalanRankOld(SIZE n,TBBS a)
{
int y = -1;
int r = 0;
RANK lo = 0;
while(a > 0)
{
if(0 == (a & 1))
{
r++;
lo += CatTriangle(r,y);
}
else
{
y++;
}
a >>= 1;
}
return(Cat(n)-(lo+1));
}
/*
See Frank Ruskey's thesis at:
http://www.cs.uvic.ca/~fruskey/Publications/Thesis/Thesis.html
*/
RANK CatalanRank(SIZE n,TBBS a)
{
int m = -1;
int y = 0;
RANK r = 0;
while(a > 0)
{
if(0 == (a & 1))
{
m++;
}
else
{
y++;
r += CatTriangle(m,y);
}
a >>= 1;
}
return(r);
}
TBBS CatalanUnrank(SIZE n,RANK r)
{
int m = n-1;
int y = n;
TBBS a = 0;
while(m >= 0)
{
RANK c = CatTriangle(m,y);
a <<= 1;
if(r >= c)
{
y--;
a++;
r -= c;
}
else
{
m--;
}
}
return(a);
}
/* This is of course not re-entrant... Code the other way,
if you e.g. need a parallel version.
*/
static int CRS_m, CRS_y;
static RANK CRS_r;
void CatalanRankSexpAux(SEXP node)
{
if(NULLP(node)) { CRS_m--; }
else
{
CRS_r += CatTriangle(CRS_m,CRS_y);
CRS_y--;
CatalanRankSexpAux(CAR(node));
CatalanRankSexpAux(CDR(node));
}
}
RANK CatalanRankSexp(SIZE n,SEXP node)
{
CRS_m = n-1;
CRS_y = n;
CRS_r = 0;
CatalanRankSexpAux(node);
return(CRS_r);
}
SEXP CatalanUnrankSexp(SIZE n,RANK r,SEXP *reused)
{
int m = n-1;
int y = n;
int sp = 0;
int rightson = 0;
SEXP root = NULL;
SEXP sonstack[MAXSIZE+1];
while(m >= 0)
{
RANK c = CatTriangle(m,y);
if(r >= c)
{
SEXP newbranch = recons(NULL,NULL,reused);
if(NULLP(root)) { root = newbranch; }
else
{
if(rightson) { SET_CDR(sonstack[sp],newbranch); }
else { SET_CAR(sonstack[sp],newbranch); sp++; }
}
sonstack[sp] = newbranch;
y--;
r -= c;
rightson = 0; /* The next one is a left son. */
}
else
{
m--;
sp -= rightson;
rightson = 1; /* The next one is a right son. */
}
}
return(root);
}
RANK CatalanRankGlobal(SIZE n,TBBS a)
{
if(0 == n) { return(0); }
else { return(A014137(n-1)+CatalanRank(n,a)); }
}
RANK CatalanRankSexpGlobal(SIZE n,SEXP s)
{
if(0 == n) { return(0); }
else { return(A014137(n-1)+CatalanRankSexp(n,s)); }
}
void print_sexp(SEXP s)
{
putchar('(');
while(!NULLP(s)) { print_sexp(CAR(s)); s = CDR(s); }
putchar(')');
}
/* See the section "Number Conversion" at the end of
the excerpt: http://www.iki.fi/~kartturi/matikka/kl10exmp.txt
*/
int fprint_ulli(FILE *fp,ULLI x)
{
int s = 0;
if(x >= 10) { s = fprint_ulli(fp,(x/((ULLI)10))); }
fputc(('0' + (x%((ULLI)10))),fp);
return(s+1);
}
/* We could as well compute it on runtime, of course... */
void CheckTriangle(int upto_n)
{
int r,m;
for(r=0; r <= upto_n; r++)
{
for(m=0; m < r; m++)
{
if((CatTriangle(r,m-1) + CatTriangle(r-1,m)) != CatTriangle(r,m))
{
fprintf(stderr,"(CatTriangle(%d,%d) + CatTriangle(%d,%d)) = ",
r,(m-1),(r-1),m);
fprint_ulli(stderr,(CatTriangle(r,m-1) + CatTriangle(r-1,m)));
fprintf(stderr," differs from CatTriangle(%d,%d) = ",
r,m);
fprint_ulli(stderr,CatTriangle(r,m));
fprintf(stderr,"\n");
exit(1);
}
}
if((r > 0) && (CatTriangle(r,m) != CatTriangle(r,m-1)))
{
fprintf(stderr,"(CatTriangle(%d,%d) = ",r,m);
fprint_ulli(stderr,CatTriangle(r,m));
fprintf(stderr," differs from CatTriangle(%d,%d) = ",r,(m-1));
fprint_ulli(stderr,CatTriangle(r,m-1));
fprintf(stderr,"\n");
exit(1);
}
}
/* fprintf(stderr,"Triangle OK!\n"); */
}
void CheckRankings(int upto_n) /* Well, superficially... */
{
int n;
RANK r,r2,uplim;
for(n=0; n <= upto_n; n++)
{
uplim = Cat(n);
for(r=0; r < uplim; r++)
{
TBBS tbs = CatalanUnrank(n,r);
if(globopt_output_cycle_lists)
{
fprint_ulli(stdout,tbs); printf(" ");
}
r2 = CatalanRank(n,tbs);
if(r2 != r)
{
fflush(stdout);
fprintf(stderr,"CatalanRank(%d,",n);
fprint_ulli(stderr,tbs);
fprintf(stderr,")=");
fprint_ulli(stderr,r2);
fprintf(stderr," != ");
fprint_ulli(stderr,r);
fprintf(stderr,"\n");
exit(1);
}
}
if(globopt_output_cycle_lists) { printf("\n"); }
}
fprintf(stdout,"Ranking & Unranking OK upto n=%d.\n", upto_n);
}
void CheckSexpRankings(int upto_n) /* Well, superficially... */
{
int n;
RANK r,r2,uplim;
SEXP old_s = NULL;
for(n=0; n <= upto_n; n++)
{
uplim = Cat(n);
for(r=0; r < uplim; r++)
{
SEXP s = CatalanUnrankSexp(n,r,&old_s);
if(globopt_output_cycle_lists)
{
print_sexp(s); printf(" ");
}
r2 = CatalanRankSexp(n,s);
if(r2 != r)
{
fflush(stdout);
fprintf(stderr,"CatalanRankSexp(%d,s)=",n);
fprint_ulli(stderr,r2);
fprintf(stderr," != ");
fprint_ulli(stderr,r);
fprintf(stderr,"\n");
exit(1);
}
old_s = s;
}
if(globopt_output_cycle_lists) { printf("\n"); }
}
fprintf(stdout,"Ranking & Unranking OK upto n=%d.\n", upto_n);
}
/**********************************************************************/
ULLI gcd(ULLI a,ULLI b)
{
ULLI ex_b;
while(0 != b)
{
ex_b = b;
b = a % b;
a = ex_b;
}
return(a);
}
/* We suppose here that b is usually a much smaller factor than a. */
ULLI lcm(ULLI a,ULLI b)
{
ULLI z = (b/gcd(a,b));
z *= a; /* z = a * (b/gcd(a,b)); */
if(z < a) { return(0); } /* Return 0 for overflow! */
else { return(z); }
}
/* Note that the above overruns easily even with 64-bit word length,
as already A060114(12) = 14510088480716327580681600
which is 83-bit integer.
*/
#define kth_byte(n) ((int) ((n) >> 3)) /* From RANK to int */
#define kth_bit(n) (((RANK)(n)) << 3) /* From int to RANK */
#define ith_bit_in_byte(n) ((BYTE) (1 << ((n) & 7))) /* From RANK to BYTE */
#define toggle_bit_on(B,n) (B[kth_byte(n)] |= ith_bit_in_byte(n))
#define bit_is_zero(B,n) (0 == (B[kth_byte(n)] & ith_bit_in_byte(n)))
RANK pos_of_first_zero_bit(BYTE *flags,RANK uplim,RANK *start_point)
{
RANK i;
BYTE b;
int h,uplim_in_bytes = kth_byte(uplim);
/* If the gatomorphism has an appropriate cycle structure then
this loop helps, otherwise it's just harmless: */
for(h=kth_byte(*start_point); (h < uplim_in_bytes) && (FILLED_BYTE == flags[h]); h++)
{
}
/* Conceptually clear, but might produce slow code,
unless the optimizer is very clever.
(We should manually unroll this loop,
as after all, there are only 8 bits in byte!)
*/
for(i=kth_bit(h); i < uplim; i++)
{
if(bit_is_zero(flags,i)) { *start_point = (i+1); return(i); }
}
return(-1);
}
char *w6d(char *tb,int n)
{
sprintf(tb,"%06u",n);
return(tb);
}
void output_HTML_Alink(FILE *fp,int Anum)
{
char tb[81] = { 'A' };
char *Astr = (w6d(tb+1,Anum)-1);
fprintf(fp,"%s",Astr,Astr);
}
void output_n_chars(int i, char c)
{
while(i--) { putchar(c); }
}
void output_n_spaces(int i) { output_n_chars(i,' '); }
void output_cycle_rep_et_length(int n,int upto_n,int r,int c,int maxcyc)
{
/* Lisp list brackets '(' and ')' sort before digits, while Maple/Prolog/Haskell
brackets '[', ']' as well as Mathematica brackets '{', '}' sort after
them.
*/
int brackets_sort_before_numbers = !!(*globopt_list_begin < '0'); /* 0 or 1. */
output_n_spaces((upto_n - n)+brackets_sort_before_numbers);
if(0 != maxcyc) { printf("%s",globopt_elem_delim); }
else /* There's no kludge we cannot solve... */
{
if(*globopt_elem_delim > '+') { putchar('+'); } /* Keep the first of each as first. */
}
if(globopt_output_cycle_lists > 1)
{
printf("%s",globopt_pair_begin);
fprint_ulli(stdout,(r+((0 == n) ? 0 : A014137(n-1))));
printf("%s",globopt_pair_delim);
}
printf("%d",c);
if(globopt_output_cycle_lists > 1) { printf("%s", globopt_pair_end); }
printf("\n");
}
int choose_implementation(struct t_gatom_descr *gato_descr,
int upto_n,
int which_implementation,
int which_one,
PFGM_SEXP *p_gm_sexp,
PFGM_TBBS *p_gm_tbbs
)
{
switch(which_implementation)
{
case FORCE_SEXP:
{
*p_gm_sexp = ((2 == which_one) ? gato_descr->gato_sexpfun2 : gato_descr->gato_sexpfun1);
if(!*p_gm_sexp)
{
fprintf(stderr,
"choose_implementation: no SEXP-version of gatomorphism %u implemented, please start again but without -S option!\n",
((1 == which_one) ? gato_descr->gato_num1 : gato_descr->gato_num2));
exit(1);
}
break;
}
case FORCE_TBBS:
{
*p_gm_tbbs = ((2 == which_one) ? gato_descr->gato_tbbsfun2 : gato_descr->gato_tbbsfun1);
if(!*p_gm_tbbs)
{
fprintf(stderr,
"choose_implementation: no TBBS-version of gatomorphism %u implemented, please start again but without -T option!\n",
((1 == which_one) ? gato_descr->gato_num1 : gato_descr->gato_num2));
exit(1);
}
break;
}
case WHICHEVER:
{
if(1 == which_one)
{
if(gato_descr->gato_sexpfun1) { *p_gm_sexp = gato_descr->gato_sexpfun1; }
else if(gato_descr->gato_tbbsfun1) { *p_gm_tbbs = gato_descr->gato_tbbsfun1; }
else
{
virhe:
fprintf(stderr,
"choose_implementation: neither SEXP- nor TBBS-version of gatomorphism %u implemented, sorry!\n",
((1 == which_one) ? gato_descr->gato_num1 : gato_descr->gato_num2));
exit(1);
}
}
else /* if(2 == which_one) */
{
if(gato_descr->gato_sexpfun2) { *p_gm_sexp = gato_descr->gato_sexpfun2; }
else if(gato_descr->gato_tbbsfun2) { *p_gm_tbbs = gato_descr->gato_tbbsfun2; }
else { goto virhe; }
}
break;
}
} /* switch(which_implementation) */
if((NULL != *p_gm_tbbs) && (upto_n > MAXSIZE_FOR_TBBS))
{
fprintf(stderr,
"choose_implementation: You can only compute up to size %u with a TBBS implementation. Try option -S if you want it up to %u.\n",
MAXSIZE_FOR_TBBS, upto_n);
exit(1);
}
return(which_one); /* Just return something... */
}
void CountCycles(int n,int upto_n,
PFGM_SEXP gm_sexp,
PFGM_TBBS gm_tbbs,
int which_implementation,
ULLI *p_cycles,ULLI *p_fixed,ULLI *p_maxcyc,ULLI *p_lcms)
{
RANK uplim = Cat(n);
int bytes_needed = ((int)(uplim >> 3))+1;
BYTE *flags = ((BYTE *) calloc(bytes_needed,sizeof(BYTE))); /* A bit table, which can grow BIG. */
RANK ff; /* First Fresh */
RANK start_point=0;
ULLI cycles=0;
ULLI fixed=0;
ULLI maxcyc=0;
SEXP sexp = NULL;
if(NULL != p_lcms) { *p_lcms = 1; }
if(NULL == flags)
{
fprintf(stderr,"Couldn't allocate a chunk of %u bytes to store Cat(%d) = ",
bytes_needed,n);
fprint_ulli(stderr,Cat(n));
fprintf(stderr," bits!\n");
exit(1);
}
if(globopt_output_cycle_lists && (0 == n))
{
output_n_spaces((upto_n - n)+1); /* Must sort absolutely first. */
printf("%s\n",globopt_list_begin);
}
while(-1 != (ff = pos_of_first_zero_bit(flags,uplim,&start_point)))
{
ULLI c = 0;
RANK r = ff;
if(gm_sexp)
{
sexp = CatalanUnrankSexp(n,r,&sexp);
do
{
c++;
toggle_bit_on(flags,r);
gm_sexp(sexp);
r = CatalanRankSexp(n,sexp);
} while(bit_is_zero(flags,r));
}
else /* if(gm_tbbs) */
{
TBBS tbs = CatalanUnrank(n,r);
do
{
c++;
toggle_bit_on(flags,r);
tbs = gm_tbbs(tbs);
r = CatalanRank(n,tbs);
} while(bit_is_zero(flags,r));
}
if(globopt_output_cycle_lists)
{
output_cycle_rep_et_length(n,upto_n,r,c,maxcyc);
}
cycles++;
if(1 == c) { fixed++; }
if(c > maxcyc) { maxcyc = c; }
if((NULL != p_lcms) && (0 != *p_lcms)) { *p_lcms = lcm(*p_lcms,c); }
}
*p_cycles = (ULLI) cycles;
*p_fixed = (ULLI) fixed;
*p_maxcyc = (ULLI) maxcyc;
if(globopt_output_cycle_lists)
{
output_n_spaces(upto_n - n);
printf("%s%s%s\n",globopt_list_end,
((n < upto_n) ? globopt_list_delim : ""),
((n < upto_n) ? globopt_list_begin : "")
);
}
output_n_spaces(upto_n - n);
printf("%s", globopt_comment_begin);
putchar(' '); fprint_ulli(stdout,cycles);
putchar(' '); fprint_ulli(stdout,fixed);
putchar(' '); fprint_ulli(stdout,maxcyc);
if(NULL != p_lcms) { putchar(' '); fprint_ulli(stdout,*p_lcms); }
printf("\n");
fflush(stdout);
free(flags);
free_cons_tree(sexp);
}
void compute_gatos_SignaturePerm(ULLI *vec,int upto_n,PFGM_SEXP gm_sexp,PFGM_TBBS gm_tbbs)
{
int n;
SEXP sexp = NULL;
TBBS tbs = 0;
RANK r;
int from_size_n = 0;
int i = 0;
for(n=from_size_n; n <= upto_n; n++)
{
for(r = 0; r < Cat(n); r++)
{
if(gm_sexp)
{
sexp = CatalanUnrankSexp(n,r,&sexp);
gm_sexp(sexp);
vec[i] = CatalanRankSexpGlobal(n,sexp);
}
else /* if(gm_tbbs) */
{
tbs = CatalanUnrank(n,r);
tbs = gm_tbbs(tbs);
vec[i] = CatalanRankGlobal(n,tbs);
}
if((++i) > upto_n) { goto ulos; }
}
}
ulos:
free_cons_tree(sexp);
}
void output_gatos_SignaturePerm(FILE *fp,int upto_n,PFGM_SEXP gm_sexp,PFGM_TBBS gm_tbbs,int from_size_n)
{
int n;
SEXP sexp = NULL;
TBBS tbs = 0;
RANK r;
int i = 0;
for(n=from_size_n; n <= upto_n; n++)
{
for(r = 0; r < Cat(n); r++)
{
if(i>0) { fprintf(fp,","); }
if(gm_sexp)
{
sexp = CatalanUnrankSexp(n,r,&sexp);
gm_sexp(sexp);
fprint_ulli(fp,CatalanRankSexpGlobal(n,sexp));
}
else /* if(gm_tbbs) */
{
tbs = CatalanUnrank(n,r);
tbs = gm_tbbs(tbs);
fprint_ulli(fp,CatalanRankGlobal(n,tbs));
}
if((++i) > upto_n) { goto ulos; }
}
}
ulos:
free_cons_tree(sexp);
}
/* Return the first position, where the inverse test fails, and 0 if succeeds. */
int notInverses(int upto_n,PFGM_SEXP gm_sexp1,PFGM_SEXP gm_sexp2,PFGM_TBBS gm_tbbs1,PFGM_TBBS gm_tbbs2)
{
int n;
SEXP sexp = NULL;
TBBS tbs = 0;
RANK locrank,r2;
int i = 1;
int from_size_n = 1;
for(n=from_size_n; n <= upto_n; n++)
{
for(locrank = 0; locrank < Cat(n); locrank++)
{
if(gm_sexp1)
{
sexp = CatalanUnrankSexp(n,locrank,&sexp);
gm_sexp1(sexp);
gm_sexp2(sexp);
r2 = CatalanRankSexpGlobal(n,sexp);
if(r2 != globrank(n,locrank))
{
return(i);
}
}
else /* if(gm_tbbs) */
{
tbs = CatalanUnrank(n,locrank);
tbs = gm_tbbs2(gm_tbbs1(tbs));
r2 = CatalanRankGlobal(n,tbs);
if(r2 != globrank(n,locrank))
{
return(i);
}
}
}
}
ulos:
free_cons_tree(sexp);
return(0);
}
void fprint_vector(FILE *fp,ULLI *vec,int uplimi)
{
int i;
fprintf(fp,"%s",globopt_list_begin);
for(i=0; i <= uplimi; i++)
{
if(i>0) { fprintf(fp,"%s",globopt_elem_delim); }
fprint_ulli(fp,*(vec+i));
}
fprintf(fp,"%s",globopt_list_end);
}
void fprint_vector_up_to_first_0(FILE *fp,ULLI *vec,int uplimi)
{
int i;
fprintf(fp,"%s",globopt_list_begin);
for(i=0; (i <= uplimi) && (0 != *(vec+i)); i++)
{
if(i>0) { fprintf(fp,"%s",globopt_elem_delim); }
fprint_ulli(fp,*(vec+i));
}
fprintf(fp,"%s",globopt_list_end);
}
/* Returns the number of terms printed if finished because no more fits, zero otherwise, when everything has been printed. */
int fprint_vector_until_line_is_full(FILE *fp,ULLI *vec,int uplimi,int max_linelen)
{
int i=0; /* Number of terms printed this time. */
int pl=0; /* Print length. */
for(;;)
{
pl += fprint_ulli(fp,vec[i++]);
if(i > uplimi) { return(0); } /* Finished. */
fprintf(fp,"%s",globopt_elem_delim); pl += strlen(globopt_elem_delim);
if(pl >= max_linelen) { return(i); } /* Return non-zero to indicate that more terms should be printed. */
}
}
int fprint_vector_up_to_first_0_or_until_line_is_full(FILE *fp,ULLI *vec,int uplimi,int max_linelen)
{
int i=0; /* Number of terms printed this time. */
int pl=0; /* Print length. */
for(;;)
{
pl += fprint_ulli(fp,vec[i++]);
if((i > uplimi) || (0 == vec[i])) { return(0); } /* Finished. */
fprintf(fp,"%s",globopt_elem_delim); pl += strlen(globopt_elem_delim);
if(pl >= max_linelen) { return(i); } /* Return non-zero to indicate that more terms should be printed. */
}
}
#define OEIS_S_T_U_LINE_MAXLEN 69
#define OEIS_SEEK_MAXLEN 140
void output_OEIS_sequence(FILE *fp,const char *name, /* E.g. "Number of cycles" */ /* in range [A014137(n-1)..A014138(n-1)] of permutation A0xxxxx/A0yyyyy. */
const char *comment1,
int Anum,char *permname,
ULLI *vec,int upto_n,
PF_VEC_OUT fprintvecfun,
struct t_gatom_descr *gato_descr,
int sigperm /* A flag. */
)
{
char tb[81] = { 'A' };
char *Astr = (w6d(tb+1,Anum)-1);
int pos_of_1st_term_gte_2 = 0;
int printed_only_up_to_nth_term = 0;
int sec_printed_only_up_to_nth_term = 0;
char *save_globopt_list_begin = globopt_list_begin;
char *save_globopt_list_end = globopt_list_end;
char *save_globopt_elem_delim = globopt_elem_delim;
/* Set these for fprint_vector: */
globopt_list_begin = "";
globopt_list_end = "";
globopt_elem_delim = ",";
while((pos_of_1st_term_gte_2 <= upto_n)
&& (*(vec+pos_of_1st_term_gte_2) < 2))
{ pos_of_1st_term_gte_2++; }
if(pos_of_1st_term_gte_2 > upto_n) { pos_of_1st_term_gte_2 = 1; } /* Not found, use 1. */
else { pos_of_1st_term_gte_2++; } /* Because One-based. */
fprintf(fp,"%%I %s\n",Astr);
if(globopt_HTML)
{
fprintf(fp,"%%S ");
output_HTML_Alink(fp,Anum);
fprintf(fp," ");
printed_only_up_to_nth_term = fprintvecfun(fp,vec,upto_n,OEIS_S_T_U_LINE_MAXLEN);
fprintf(fp, "");
}
else
{
fprintf(fp,"%%S %s ",Astr);
printed_only_up_to_nth_term = fprintvecfun(fp,vec,upto_n,OEIS_S_T_U_LINE_MAXLEN);
}
fprintf(fp,"\n");
if(printed_only_up_to_nth_term > 0) /* Continue onto the %T -line ? */
{
fprintf(fp,"%%T %s ",Astr);
sec_printed_only_up_to_nth_term = fprintvecfun(fp,vec+printed_only_up_to_nth_term,upto_n-printed_only_up_to_nth_term,OEIS_S_T_U_LINE_MAXLEN);
fprintf(fp,"\n");
}
if(sec_printed_only_up_to_nth_term > 0) /* Continue onto the %U -line ? */
{
printed_only_up_to_nth_term += sec_printed_only_up_to_nth_term ;
fprintf(fp,"%%U %s ",Astr);
fprintvecfun(fp,vec+printed_only_up_to_nth_term,upto_n-printed_only_up_to_nth_term,OEIS_S_T_U_LINE_MAXLEN);
fprintf(fp,"\n");
}
fprintf(fp,"%%N %s %s",Astr,name);
if(sigperm)
{
fprintf(fp,".\n");
}
else
{
fprintf(fp," in range [A014137(n-1)..A014138(n-1)] of permutation %s.\n",permname);
}
if(NULL != comment1)
{
fprintf(fp,"%%C %s %s\n",Astr,comment1);
}
if(sigperm)
{
fprintf(fp,"%%H %s A. Karttunen, C-program for computing this sequence\n",
Astr);
}
else
{
fprintf(fp,"%%H %s A. Karttunen, C-program for computing the initial terms of this sequence\n",
Astr);
}
if(sigperm)
{
char tb1[21];
fprintf(fp,"%%H %s Index entries for signature-permutations induced by Catalan automorphisms\n",
Astr);
if(0 != (gato_descr->gato_ccs + gato_descr->gato_fix
+ gato_descr->gato_max + gato_descr->gato_lcm)
)
{
fprintf(fp,"%%Y %s",Astr);
if(0 != gato_descr->gato_ccs)
{
fprintf(fp," Number of cycles: A%s.",w6d(tb1,gato_descr->gato_ccs));
}
if(0 != gato_descr->gato_fix)
{
fprintf(fp," Number of fixed points: A%s.",w6d(tb1,gato_descr->gato_fix));
}
if(0 != gato_descr->gato_max && (gato_descr->gato_max == gato_descr->gato_lcm))
{
fprintf(fp," Max. cycle size & LCM of all cycle sizes: A%s.",w6d(tb1,gato_descr->gato_max));
}
else
{
if(0 != gato_descr->gato_max)
{
fprintf(fp," Max. cycle size: A%s.",w6d(tb1,gato_descr->gato_max));
}
if(0 != gato_descr->gato_lcm)
{
fprintf(fp," LCM of cycle sizes: A%s.",w6d(tb1,gato_descr->gato_lcm));
}
}
fprintf(fp," (in range [A014137(n-1)..A014138(n-1)] of this permutation, possibly shifted one term left or right).\n");
}
}
fprintf(fp,"%%K %s nonn\n",Astr);
fprintf(fp,"%%O %s 0,%u\n",Astr,pos_of_1st_term_gte_2);
fprintf(fp,"%%A %s %s, %s\n", Astr, glob_author_info, glob_datestr); /* E.g. Antti Karttunen (Firstname.Surname@iki.fi), Oct 28 2003 */
fprintf(fp,"\n");
fflush(fp);
globopt_list_begin = save_globopt_list_begin;
globopt_list_end = save_globopt_list_end;
save_globopt_elem_delim = save_globopt_elem_delim;
}
void count_gatos_four_sequences(FILE *fp,int upto_n,struct t_gatom_descr *gato_descr)
{
{
PFGM_SEXP gm_sexp = NULLGMS;
PFGM_TBBS gm_tbbs = NULLGMT;
int n;
ULLI v_cycles[MAXSIZE+1],v_fixed[MAXSIZE+1],v_maxcyc[MAXSIZE+1],v_lcms[MAXSIZE+1];
ULLI *p_lcms = v_lcms;
char tb1[21],tb2[21];
char permname[51];
choose_implementation(gato_descr,upto_n,glob_which_implementation,glob_which_one,&gm_sexp,&gm_tbbs);
for(n=0; n <= upto_n; n++)
{
CountCycles(n, upto_n, gm_sexp, gm_tbbs, glob_which_implementation,
&(v_cycles[n]), &(v_fixed[n]), &(v_maxcyc[n]), p_lcms);
if(NULL == p_lcms) { v_lcms[n] = 0; }
else /* if(NULL != p_lcms) */
{
if(0 != *p_lcms) { p_lcms++; }
else { p_lcms = NULL; } /* Do not compute lcms after it has once overflowed. */
}
}
if(gato_descr->gato_num1 != gato_descr->gato_num2)
{
sprintf(permname,"A%s/A%s",w6d(tb1,gato_descr->gato_num1),
w6d(tb2,gato_descr->gato_num2)
);
}
else /* It's an involution. */
{
sprintf(permname,"A%s",w6d(tb1,gato_descr->gato_num1));
}
output_OEIS_sequence(fp,"Number of cycles", /* in range [A014137(n-1)..A014138(n-1)] of permutation A0xxxxx/A0yyyyy. */
"The number of orbits to which the corresponding automorphism(s) partitions the set of A000108(n) binary trees of n internal nodes.",
gato_descr->gato_ccs,permname,
v_cycles,upto_n,
fprint_vector_until_line_is_full,
gato_descr,0
);
output_OEIS_sequence(fp,"Number of fixed points",
"The number of n-node binary trees fixed by the corresponding automorphism(s).",
gato_descr->gato_fix,permname,
v_fixed,upto_n,
fprint_vector_until_line_is_full,
gato_descr,0
);
output_OEIS_sequence(fp,"Maximum cycle size",NULL,
gato_descr->gato_max,permname,
v_maxcyc,upto_n,
fprint_vector_until_line_is_full,
gato_descr,0
);
output_OEIS_sequence(fp,"Least common multiple of all cycle sizes",NULL,
gato_descr->gato_lcm,permname,
v_lcms,upto_n,
fprint_vector_up_to_first_0_or_until_line_is_full,
gato_descr,0
);
}
}
/***********************************************************************/
void map_over_Gatomorphisms(FILE *fp,int upto_n,PF_GATO_OUT do_it)
{
int i=0;
struct t_gatom_descr *gato_descr;
while((gato_descr = &(Gatomorphisms[i++])) && (0 != gato_descr->gato_num1))
{
do_it(fp,upto_n,gato_descr);
}
}
void describe_gatomorphism(FILE *fp,int upto_n,struct t_gatom_descr *gato_descr)
{
if(gato_descr->gato_num1 != gato_descr->gato_num2)
{
fprintf(fp,"A0%u/A0%u - %s.\n",gato_descr->gato_num1,gato_descr->gato_num2,gato_descr->gato_description);
}
else
{
fprintf(fp,"A0%u - %s.\n",gato_descr->gato_num1,gato_descr->gato_description);
}
}
void list_Gatomorphisms(FILE *fp) { map_over_Gatomorphisms(fp,0,describe_gatomorphism); }
void checkInverses(FILE *fp,int upto_n,struct t_gatom_descr *gato_descr)
{
PFGM_SEXP gm_sexp1 = NULLGMS;
PFGM_TBBS gm_tbbs1 = NULLGMT;
PFGM_SEXP gm_sexp2 = NULLGMS;
PFGM_TBBS gm_tbbs2 = NULLGMT;
char tb1[21],tb2[21];
int e;
if((NULLGMS != gato_descr->gato_sexpfun2)
||
(NULLGMT != gato_descr->gato_tbbsfun2)
)
{
choose_implementation(gato_descr,MAXSIZE_FOR_TBBS,glob_which_implementation,1,&gm_sexp1,&gm_tbbs1);
choose_implementation(gato_descr,MAXSIZE_FOR_TBBS,glob_which_implementation,2,&gm_sexp2,&gm_tbbs2);
if(0 < (e = notInverses(upto_n,gm_sexp1,gm_sexp2,gm_tbbs1,gm_tbbs2)))
{
fprintf(fp,"Gatomorphisms A%s and A%s not inverses of each other? Condition broken at n=%u\n",
w6d(tb1,gato_descr->gato_num1),
w6d(tb2,gato_descr->gato_num2),
e
);
}
else
{
fprintf(fp,"Gatomorphisms A%s and A%s seem to be inverses of each other when tested up to size n=%u\n",
w6d(tb1,gato_descr->gato_num1),
w6d(tb2,gato_descr->gato_num2),
upto_n
);
}
}
else
{
fprintf(fp,"Gatomorphisms A%s and A%s probably inverses of each other, but can't test it because there is no implementation for the latter!\n",
w6d(tb1,gato_descr->gato_num1),
w6d(tb2,gato_descr->gato_num2)
);
}
fflush(fp);
}
void output_HTML_gatos_SignaturePerm(FILE *fp,ULLI *vec,int upto_n,PFGM_SEXP gm_sexp,PFGM_TBBS gm_tbbs,int Anum,struct t_gatom_descr *gato_descr)
{
char tb1[21];
char permname[51],gmname[151];
sprintf(permname,"A%s",w6d(tb1,Anum));
sprintf(gmname,"Signature-permutation of the gatomorphism gma%s",w6d(tb1,Anum));
compute_gatos_SignaturePerm(vec,upto_n,gm_sexp,gm_tbbs);
output_OEIS_sequence(fp,gmname,
gato_descr->gato_description,
Anum,permname,
vec,upto_n,
fprint_vector_until_line_is_full,
gato_descr,1
);
}
#define MAX_UPTO_N_FOR_SIGPERMS 626 /* A014137(7) = 626 */
void output_HTML_both_gatos_SignaturePerm(FILE *fp,int upto_n,struct t_gatom_descr *gato_descr)
{
PFGM_SEXP gm_sexp = NULLGMS;
PFGM_TBBS gm_tbbs = NULLGMT;
ULLI vec[MAX_UPTO_N_FOR_SIGPERMS+1];
if(upto_n > MAX_UPTO_N_FOR_SIGPERMS) { upto_n = MAX_UPTO_N_FOR_SIGPERMS; }
{
choose_implementation(gato_descr,MAXSIZE_FOR_TBBS,glob_which_implementation,1,&gm_sexp,&gm_tbbs);
output_HTML_gatos_SignaturePerm(fp,vec,upto_n,gm_sexp,gm_tbbs,gato_descr->gato_num1,gato_descr);
}
if((gato_descr->gato_num2 != gato_descr->gato_num1)
&& ((NULLGMS != gato_descr->gato_sexpfun2)
||
(NULLGMT != gato_descr->gato_tbbsfun2)
)
)
{
choose_implementation(gato_descr,MAXSIZE_FOR_TBBS,glob_which_implementation,2,&gm_sexp,&gm_tbbs);
output_HTML_gatos_SignaturePerm(fp,vec,upto_n,gm_sexp,gm_tbbs,gato_descr->gato_num2,gato_descr);
}
fprintf(fp,"\n");
fflush(fp);
}
void output_HTML_checkfile(FILE *fp,int upto_n)
{
fprintf(fp,"A check-list of gatomorphism signature-permutations produced by gatomorf.c\n");
fprintf(fp,"\n");
fprintf(fp,"\n");
map_over_Gatomorphisms(fp,upto_n,output_HTML_both_gatos_SignaturePerm);
fprintf(fp,"\n");
}
void output_HTML_countfile(FILE *fp,int upto_n)
{
fprintf(fp,"A check-list of gatomorphism count sequences produced by gatomorf.c\n");
fprintf(fp,"\n");
fprintf(fp,"\n");
map_over_Gatomorphisms(fp,upto_n,count_gatos_four_sequences);
fprintf(fp,"\n");
}
struct t_gatom_descr *find_Gatomorphism(int gatonum,int *which)
{
int i=0;
struct t_gatom_descr *gato_descr;
while((gato_descr = &(Gatomorphisms[i++])) && (0 != gato_descr->gato_num1))
{
if(gato_descr->gato_num1 == gatonum)
{ *which = 1; return(gato_descr); }
if(gato_descr->gato_num2 == gatonum)
{ *which = 2; return(gato_descr); }
}
fprintf(stderr,"Sorry, gatomorphism %u not implemented!\n",
gatonum
);
return(NULL);
}
/**********************************************************************/
int main(int argc, char **argv)
{
ULLI x = (ULLI) (((SLLI) -1));
char *progname = *argv;
char *tharg;
int gatonum = 0,upto_n;
struct t_gatom_descr *gato_descr;
char *count_or_check = NULL;
CheckTriangle(19);
if(argc < 3)
{
usage:
fprintf(stderr,"usage: %s A0xxxxx size [-l]\n", progname);
fprintf(stderr,
"Here size is between [0,%d], and A0xxxxx is one of the following gatomorphisms:\n",
MAXSIZE);
list_Gatomorphisms(stderr);
fprintf(stderr,"\nA014486 - Special usage: gives the terms of A014486 up to the size n.\n");
fprintf(stderr,"Or use the form: %s CHECK 197 -H to produce an HTML check file of signature permutations.\n", progname);
fprintf(stderr,"and the form: %s COUNTALL size to compute all sequences up to the size given.\n", progname);
exit(1);
}
if((NULL == (tharg = *++argv))
|| !(isdigit(*tharg) || ('a' == *tharg) || ('A' == *tharg) || ('c' == *tharg) || ('C' == *tharg) || ('i' == *tharg) || ('I' == *tharg))
)
{ goto usage; }
else if(isdigit(*tharg) || ('A' == toupper(*tharg)))
{
gatonum = atoi(tharg+(!isdigit(*tharg)));
if(14486 == gatonum)
{
}
else if(!(gato_descr = find_Gatomorphism(gatonum,&glob_which_one))) { goto usage; }
}
else { count_or_check = tharg; } /* We might have "CHECK" or "COUNTALL" or "INVTEST" instead of "A0xxxxx" */
if((NULL == (tharg = *++argv)) || !(isdigit(*tharg)))
{ goto usage; }
else
{
upto_n = atoi(tharg);
if((upto_n < 0) || ((0 != gatonum) && (upto_n > MAXSIZE)))
{
goto usage;
}
}
while((tharg = *++argv) && ('-' == *tharg))
{
char c;
while(c=*++tharg)
{
switch(c)
{
case 'l':
{
globopt_output_cycle_lists++;
break;
}
case 'A':
{
if(NULL == (glob_author_info = *++argv))
{
fprintf(stderr,"Option -A requires an argument. Example: -A \"Apollonius Sequentius (apo.seq(AT)someaddress.edu)\"\n");
goto usage;
}
break;
}
case 'D':
{
if(NULL == (glob_datestr = *++argv))
{
fprintf(stderr,"Option -D requires an argument. Example: -D \"Oct 28 2003\"\n");
goto usage;
}
break;
}
case 'H':
{
globopt_HTML = 1;
break;
}
case 'M': /* Maple-output and Haskell/Prolog-output. */
{
globopt_list_begin = "[";
globopt_list_delim = ",";
globopt_list_end = "]";
globopt_elem_delim = ",";
globopt_pair_begin = "[";
globopt_pair_delim = ",";
globopt_pair_end = "]";
globopt_comment_begin = "#";
break;
}
case 'R':
{
CheckRankings(upto_n);
CheckSexpRankings(upto_n);
exit(0);
break;
}
case 'S':
{
glob_which_implementation = FORCE_SEXP;
break;
}
case 'T':
{
glob_which_implementation = FORCE_TBBS;
break;
}
default:
{
fprintf(stderr,"Unknown option %s !\n",tharg);
goto usage;
}
}
}
}
if(14486 == gatonum)
{
globopt_output_cycle_lists++;
CheckRankings(upto_n);
if(globopt_output_cycle_lists > 1) { CheckSexpRankings(upto_n); }
exit(0);
}
if(NULL != count_or_check) /* i.e. (0 == gatonum) so We had "CHECK" or "COUNTALL" instead of "A0xxxxx" */
{
if('C' == toupper(count_or_check[0]))
{
if((count_or_check[1]) && ('H' == toupper(count_or_check[1])))
{
output_HTML_checkfile(stdout,upto_n);
}
else
{
output_HTML_countfile(stdout,upto_n);
}
}
else
{
map_over_Gatomorphisms(stdout,upto_n,checkInverses);
}
exit(0);
}
count_gatos_four_sequences(stdout,upto_n,gato_descr);
}
/* Just reverse the binary expansion: */
ULLI A030101(ULLI a)
{
ULLI b = 0;
while(0 != a)
{
b <<= 1;
b |= ((a)&1);
a >>= 1;
}
return(b);
}
int A070939(ULLI n) /* Binary width of n, with width of "0" = 1. */
{
int i = 0;
if(0 == n) { return(1); }
while(0 != n)
{
i++;
n >>= 1;
}
return(i);
}
/* Just reverse and complement the totally balanced binary string. */
TBBS gmt_A057164(TBBS a)
{
TBBS b = 0;
while(0 != a)
{
b <<= 1;
b |= ((~a)&1);
a >>= 1;
}
return(b);
}
/* Keep two "parallel" stacks, the other for the reconstructed
totally balanced binary strings, and the other for their
corresponding sizes.
Start scanning the argument 'a' from the end, pushing
zeros (leaves) to the stack, and joining to topmost
subtrees (-binary strings) popped from the stack
when 1 is encountered.
Note that this doesn't run correctly for size=32
binary trees, i.e. with 64-bit tbbs'es, as
the usually discarded last-leaf-zero is used
in the routine.
*/
TBBS gmt_A057163(TBBS a)
{
TBBS tree_stack[MAXSIZE+1], *tsp = &(tree_stack[MAXSIZE+1]);
TBBS size_stack[MAXSIZE+1], *ssp = &(size_stack[MAXSIZE+1]);
TBBS b;
*--tsp = 0; /* The last leaf is implicit, not marked in a. */
*--ssp = 1; /* And its size is 1. */
while(0 != a)
{
if(0 == (a&1)) /* Push zeros (leaves) to stack. */
{ *--tsp = 0; *--ssp = 1; }
else /* It's 1, join two branches in swapped order. */
{
TBBS left = *tsp++;
TBBS right = *tsp++;
ULLI lefsi = *ssp++;
ULLI rigsi = *ssp++;
*--ssp = (LONG_ONE+lefsi+rigsi);
*--tsp = two_to(lefsi+rigsi) + (right << lefsi) + left;
}
a >>= 1;
}
return((*tsp >> 1)); /* Discard the last leaf. */
}
/* This is where it all began, from Wouter Meeussen's message
on SeqFan mailing list:
From: Wouter Meeussen
To: "'seqfan@ext.jussieu.fr'"
Subject: je-ne-sais-quoi, again...
Date: Tue, 2 May 2000 19:02:32 +0100
trees : depth first or width first
example:
1
1 1
0 1 1 1
0 0 0 0 0 1
0 0
depth first (caterpillar-wise) is ( 1( 1 0 (1 0 0) ) (1 (1 0 0) (1 0 (100) ) ) )
0 1 2 3456 78 9A BC DE
width first is row-by-row: (1)(1 1) (0111)(00 00 01)(00)
10 0000 1110 11 1
...
For comparison, here is the Scheme-definition of A057118 (the inverse of A057117),
operating on S-expressions:
;; Convert (a . (b . rest)) --> ((a . b) . rest)
;; with no cons cells wasted.
(define (cons2top! stack)
(let ((ex-cdr (cdr stack)))
(set-cdr! stack (car ex-cdr))
(set-car! ex-cdr stack)
ex-cdr
)
)
(define (gma057118 bt) ;; Was: df->bf
(let ((conts (list car))) ;; The last thing we do is take car
(let recurse ((bt bt) (depth 0))
(let* ((plp (nthcdr depth conts))
(pass-left (and (pair? plp) (car plp)))
(newcont (lambda (stack)
((or pass-left (list-ref conts (-1+ depth)))
(if (pair? bt) (cons2top! stack) (cons bt stack))
)
)
)
)
(if pass-left
(set-car! plp newcont)
(append! conts (list newcont))
)
(cond ((pair? bt)
(recurse (car bt) (1+ depth))
(recurse (cdr bt) (1+ depth))
)
)
) ; let*
) ;; let recurse
((car (last-pair conts)) (list)) ;; Now, apply the last of closures to ()
)
)
*/
TBBS gmt_A057117_aux(TBBS n,int i,int r)
{
int j,c,w;
TBBS x,y;
if(0 == ((n)&1)) { return(0); }
for(c = i, j = 1; j <= r; j++)
{
c += (n & 1);
n >>= 1;
}
w = c << 1; /* w = 2*c */
i <<= 1; /* i = 2*i */
/* Now w = twice the count of ones on preceding row, the width of the next one.
n points to the beginning of the next row.
*/
for(c = 0, j = 1; j <= i; j++)
{
c += (n & 1);
n >>= 1;
}
/* Now the 1-bit at the beginning of n is "c":th 1 in whole n (zero-based). */
x = gmt_A057117_aux(n,c,(w-(j-1)));
y = gmt_A057117_aux(n>>1,c+(n&1),(w-j));
i = A070939(y); /* reuse i */
return((((TBBS)1) << (i+A070939(x))) + (x << i) + y);
}
TBBS gmt_A057117(TBBS a) { return(gmt_A057117_aux(A030101(a),0,1) >> 1); }
/**********************************************************************/
/* */
/* S-expression destructively modifying implementations. */
/* */
/**********************************************************************/
/* Few essential non-recursive gatomorphisms.
Most of the rest can be built from these ones.
*/
void gms_A069770(SEXP s) /* Swap the sides, (a . b) --> (b . a) */
{
if(PAIR(s))
{
SEXP org_car = CAR(s);
SET_CAR(s,CDR(s));
SET_CDR(s,org_car);
}
}
/*
See http://www.research.att.com/~njas/sequences/gatonore.c.txt
to understand these.
;; (permute-a060118 (vector 'a 'b 'c 'd 'e 'f 'g) 3 0) --> #(a b c)
;; (permute-a060118 (vector 'a 'b 'c 'd 'e 'f 'g) 3 1) --> #(b a c)
;; (permute-a060118 (vector 'a 'b 'c 'd 'e 'f 'g) 3 2) --> #(a c b)
;; (permute-a060118 (vector 'a 'b 'c 'd 'e 'f 'g) 3 3) --> #(b c a)
;; (permute-a060118 (vector 'a 'b 'c 'd 'e 'f 'g) 3 4) --> #(c b a)
;; (permute-a060118 (vector 'a 'b 'c 'd 'e 'f 'g) 3 5) --> #(c a b)
*/
void gms_A072796(SEXP s) /* (a . (b . c)) --> (b . (a . c)) */
{
if(PAIR(s) && PAIR(CDR(s)))
{
SEXP org_car = CAR(s);
SET_CAR(s,CAR(CDR(s)));
SET_CAR(CDR(s),org_car);
}
}
/* CLAUSE gmA089850[]= { CLAUSESEQ_begin(3,1), { 2, 0, 0, 2 } }; = A089840[3] */
void gms_A089850(SEXP s) /* (a . (b . c)) --> (a . (c . b)) */
{
SEXP cdr_s;
if(PAIR(s) && PAIR(cdr_s = CDR(s)))
{
SEXP org_cadr = CAR(cdr_s);
SET_CAR(cdr_s,CDR(cdr_s));
SET_CDR(cdr_s,org_cadr);
}
}
/* CLAUSE gmA089851[]= { CLAUSESEQ_begin(3,1), { 2, 0, 0, 3 } };= A089840[4] */
void gms_A089851(SEXP s) /* (a . (b . c)) --> (b . (c . a)) */
{
SEXP cdr_s;
if(PAIR(s) && PAIR(cdr_s = CDR(s)))
{
SEXP org_cadr = CAR(cdr_s); /* b. */
SET_CAR(cdr_s,CDR(cdr_s)); /* c to b's place. */
SET_CDR(cdr_s,CAR(s)); /* a to c's place. */
SET_CAR(s,org_cadr); /* b to a's place. */
}
}
/* CLAUSE gmA089852[]= { CLAUSESEQ_begin(3,1), { 2, 0, 0, 4 } };= A089840[5] */
void gms_A089852(SEXP s) /* (a . (b . c)) --> (c . (b . a)) */
{
SEXP cdr_s;
if(PAIR(s) && PAIR(cdr_s = CDR(s)))
{
SEXP org_cddr = CDR(cdr_s); /* Save org. c */
SET_CDR(cdr_s,CAR(s)); /* Place a in its stead. */
SET_CAR(s,org_cddr); /* And org. c to the place of a. */
}
}
/* CLAUSE gmA089853[]= { CLAUSESEQ_begin(3,1), { 2, 0, 0, 5 } };= A089840[6] */
void gms_A089853(SEXP s) /* (a . (b . c)) --> (c . (a . b)) */
{
SEXP cdr_s;
if(PAIR(s) && PAIR(cdr_s = CDR(s)))
{
SEXP org_cadr = CAR(cdr_s); /* b. */
SET_CAR(cdr_s,CAR(s)); /* a to b's place. */
SET_CAR(s,CDR(cdr_s)); /* c to a's place. */
SET_CDR(cdr_s,org_cadr); /* b to c's place. */
}
}
/* CLAUSE gmA089854[]= { CLAUSESEQ_begin(3,1), { 2, 1, 1, 1 } };= A089840[7] */
void gms_A089854(SEXP s) /* ((a . b) . c) --> ((b . a) . c) */
{
SEXP car_s;
if(PAIR(s) && PAIR(car_s = CAR(s)))
{
SEXP org_caar = CAR(car_s);
SET_CAR(car_s,CDR(car_s));
SET_CDR(car_s,org_caar);
}
}
/* CLAUSE gmA072797[]= { CLAUSESEQ_begin(3,1), { 2, 1, 1, 2 } };= A089840[8] */
void gms_A072797(SEXP s) /* ((a . b) . c) --> ((a . c) . b) */
{
if(PAIR(s) && PAIR(CAR(s)))
{
SEXP org_cdr = CDR(s);
SET_CDR(s,CDR(CAR(s)));
SET_CDR(CAR(s),org_cdr);
}
}
/* CLAUSE gmA089855[]= { CLAUSESEQ_begin(3,1), { 2, 1, 1, 3 } };= A089840[9] */
void gms_A089855(SEXP s) /* ((a . b) . c) --> ((b . c) . a) */
{
SEXP car_s;
if(PAIR(s) && PAIR(car_s = CAR(s)))
{
SEXP org_caar = CAR(car_s); /* a. */
SET_CAR(car_s,CDR(car_s)); /* b to a's place. */
SET_CDR(car_s,CDR(s)); /* c to b's place. */
SET_CDR(s,org_caar); /* a to c's place. */
}
}
/* CLAUSE gmA089856[]= { CLAUSESEQ_begin(3,1), { 2, 1, 1, 4 } };= A089840[10] */
void gms_A089856(SEXP s) /* ((a . b) . c) --> ((c . b) . a) */
{
SEXP car_s;
if(PAIR(s) && PAIR(car_s = CAR(s)))
{
SEXP org_caar = CAR(car_s); /* Save org. a */
SET_CAR(car_s,CDR(s)); /* Place c in its stead. */
SET_CDR(s,org_caar); /* And org. a to the place of c. */
}
}
/* CLAUSE gmA089857[]= { CLAUSESEQ_begin(3,1), { 2, 1, 1, 5 } };= A089840[11] */
void gms_A089857(SEXP s) /* ((a . b) . c) --> ((c . a) . b) */
{
SEXP car_s;
if(PAIR(s) && PAIR(car_s = CAR(s)))
{
SEXP org_caar = CAR(car_s); /* a. */
SET_CAR(car_s,CDR(s)); /* c to a's place. */
SET_CDR(s,CDR(car_s)); /* b to c's place. */
SET_CDR(car_s,org_caar); /* a to b's place. */
}
}
/* CLAUSE gmA074679[] = { CLAUSESEQ_begin(4,2), { 2, 0, 1, 0,}, { 1, 0, 0, 1 } };= A089840[12] */
/* Effect the change (a . (b . c)) --> ((a . b) . c)
if cdr-side is a pair, otherwise just swap like gms_A069770
*/
void gms_A074679(SEXP s)
{
if(PAIR(s))
{
SEXP org_car = CAR(s);
if(PAIR(CDR(s))) /* We have (a . (b . rest)) */
{
SEXP org_cdr = CDR(s);
SET_CAR(s,org_cdr); /* ((b . rest) . (b . rest)) */
SET_CDR(s,CDR(org_cdr)); /* ((b . rest) . rest) */
SET_CDR(org_cdr,CAR(org_cdr)); /* ((b . b) . rest) */
SET_CAR(org_cdr,org_car); /* ((a . b) . rest) */
}
else
{
SET_CAR(s,NULL); /* I.e. = CDR(s) */
SET_CDR(s,org_car);
}
}
}
/* Effect the change ((a . b) . rest) --> (a . (b . rest))
if car-side is a pair, otherwise just swap like gms_A069770
*/
void gms_A074680(SEXP s)
{
if(PAIR(s))
{
SEXP org_cdr = CDR(s);
if(PAIR(CAR(s))) /* We have ((a . b) . rest) */
{
SEXP org_car = CAR(s);
SET_CDR(s,org_car); /* ((a . b) . (a . b)) */
SET_CAR(s,CAR(org_car)); /* (a . (a . b)) */
SET_CAR(org_car,CDR(org_car)); /* (a . (b . b)) */
SET_CDR(org_car,org_cdr); /* (a . (b . rest)) */
}
else
{
SET_CDR(s,NULL); /* I.e. = CAR(s) */
SET_CAR(s,org_cdr);
}
}
}
/* CLAUSE gmA089865[] = { CLAUSESEQ_begin(24,2), { 3, 3, 4, 0 }, { 2, 1, 1, 1 } };= A089840[4207] */
/* ((a . (b . c)) . d) --> (((a . b) . c) . d), ((a . ()) . c) --> ((() . a) . c) */
/*
void gms_A089865(SEXP s)
{
if(PAIR(s)) { gms_A074679(CAR(s)); }
}
*/
/* CLAUSE gmA089866[] = { CLAUSESEQ_begin(24,2), { 3, 4, 3, 0 }, { 2, 1, 1, 1 } };= A089840[4299] */
/* (((a . b) . c) . d) --> ((a . (b . c)) . d), ((() . b) . c) --> ((b . ()) . c) */
/*
void gms_A089866(SEXP s)
{
if(PAIR(s)) { gms_A074680(CAR(s)); }
}
*/
/* Effect this change:
A D
\ /
A D B C Q B A B [] A
\ / \ / \ / \ / \ / and by default:
P M --> N C M [] --> N B [] A [] A
\ / \ / \ / \ / \ / --> \ /
X Y X Y X Y
*/
void gms_A082351(SEXP s)
{
if(PAIR(s) && PAIR(CAR(s)))
{
SEXP org_car = CAR(s);
if(!PAIR(CDR(s)))
{
SET_CAR(s,NULL); /* I.e. = CDR(s) */
SET_CDR(s,org_car);
org_car = NULL;
}
/* Now we have (a . (b . rest)). Rotate it left. */
{
SEXP org_cdr = CDR(s);
SET_CAR(s,org_cdr); /* ((b . rest) . (b . rest)) */
SET_CDR(s,CDR(org_cdr)); /* ((b . rest) . rest) */
SET_CDR(org_cdr,CAR(org_cdr)); /* ((b . b) . rest) */
SET_CAR(org_cdr,org_car); /* ((a . b) . rest) */
}
}
}
/* Same to the other direction. Inverse of the gms_A082351. */
void gms_A082352(SEXP s)
{
if(PAIR(s) && PAIR(CAR(s)))
{
if(!PAIR(CAR(CAR(s)))) { gms_A074680(s); gms_A069770(s); }
else { gms_A074680(s); }
}
}
/* Rotate a binary tree right if possible and recurse down both branches, otherwise apply swap and terminate. */
void gms_A071655(SEXP s)
{
if(PAIR(s))
{
SEXP org_cdr = CDR(s);
if(PAIR(CAR(s))) /* We have ((a . b) . rest) */
{
SEXP org_car = CAR(s);
SET_CDR(s,org_car); /* ((a . b) . (a . b)) */
SET_CAR(s,CAR(org_car)); /* (a . (a . b)) */
SET_CAR(org_car,CDR(org_car)); /* (a . (b . b)) */
SET_CDR(org_car,org_cdr); /* (a . (b . rest)) */
gms_A071655(CAR(s));
gms_A071655(CDR(s));
}
else
{
SET_CDR(s,NULL); /* I.e. = CAR(s) */
SET_CAR(s,org_cdr);
}
}
}
/* Inverse of gms_A071655 */
void gms_A071656(SEXP s)
{
if(PAIR(s))
{
SEXP org_car = CAR(s);
if(PAIR(CDR(s))) /* We have (a . (b . rest)) */
{
SEXP org_cdr;
gms_A071656(CAR(s)); /* First recurse down ... */
gms_A071656(CDR(s)); /* ... on both branches, before doing robl! */
org_cdr = CDR(s);
SET_CAR(s,org_cdr); /* ((b . rest) . (b . rest)) */
SET_CDR(s,CDR(org_cdr)); /* ((b . rest) . rest) */
SET_CDR(org_cdr,CAR(org_cdr)); /* ((b . b) . rest) */
SET_CAR(org_cdr,org_car); /* ((a . b) . rest) */
}
else
{
SET_CAR(s,NULL); /* I.e. = CDR(s) */
SET_CDR(s,org_car);
}
}
}
/* If robr not possible, apply swap, otherwise recurse down on both branches and after that rotate binary tree right */
void gms_A071659(SEXP s)
{
if(PAIR(s))
{
SEXP org_cdr = CDR(s);
if(PAIR(CAR(s))) /* We have ((a . b) . rest) */
{
SEXP org_car;
gms_A071659(CAR(s));
gms_A071659(CDR(s));
org_car = CAR(s);
SET_CDR(s,org_car); /* ((a . b) . (a . b)) */
SET_CAR(s,CAR(org_car)); /* (a . (a . b)) */
SET_CAR(org_car,CDR(org_car)); /* (a . (b . b)) */
SET_CDR(org_car,org_cdr); /* (a . (b . rest)) */
}
else
{
SET_CDR(s,NULL); /* I.e. = CAR(s) */
SET_CAR(s,org_cdr);
}
}
}
/* Inverse of gms_A071659 */
void gms_A071660(SEXP s)
{
if(PAIR(s))
{
SEXP org_car = CAR(s);
if(PAIR(CDR(s))) /* We have (a . (b . rest)) */
{
SEXP org_cdr = CDR(s);
SET_CAR(s,org_cdr); /* ((b . rest) . (b . rest)) */
SET_CDR(s,CDR(org_cdr)); /* ((b . rest) . rest) */
SET_CDR(org_cdr,CAR(org_cdr)); /* ((b . b) . rest) */
SET_CAR(org_cdr,org_car); /* ((a . b) . rest) */
gms_A071660(CAR(s)); /* Then recurse down ... */
gms_A071660(CDR(s)); /* ... on both branches, AFTER doing robl! */
}
else
{
SET_CAR(s,NULL); /* I.e. = CDR(s) */
SET_CDR(s,org_car);
}
}
}
/* Hybrid:
Effect the change (a . (b . rest)) --> ((a . b) . rest)
if cdr-side is a pair, otherwise just reflect like gms_A057163
*/
void gms_A082335(SEXP s)
{
if(PAIR(s))
{
SEXP org_car = CAR(s);
if(PAIR(CDR(s))) /* We have (a . (b . rest)) */
{
SEXP org_cdr = CDR(s);
SET_CAR(s,org_cdr); /* ((b . rest) . (b . rest)) */
SET_CDR(s,CDR(org_cdr)); /* ((b . rest) . rest) */
SET_CDR(org_cdr,CAR(org_cdr)); /* ((b . b) . rest) */
SET_CAR(org_cdr,org_car); /* ((a . b) . rest) */
}
else { gms_A057163(s); }
}
}
/* Effect the change ((a . b) . rest) --> (a . (b . rest))
if car-side is a pair, otherwise just reflect like gms_A057163
*/
void gms_A082336(SEXP s)
{
if(PAIR(s))
{
SEXP org_cdr = CDR(s);
if(PAIR(CAR(s))) /* We have ((a . b) . rest) */
{
SEXP org_car = CAR(s);
SET_CDR(s,org_car); /* ((a . b) . (a . b)) */
SET_CAR(s,CAR(org_car)); /* (a . (a . b)) */
SET_CAR(org_car,CDR(org_car)); /* (a . (b . b)) */
SET_CDR(org_car,org_cdr); /* (a . (b . rest)) */
}
else { gms_A057163(s); }
}
}
/* Hybrid:
Effect the change (a . (b . rest)) --> ((a . b) . rest)
if cdr-side is a pair, otherwise apply gms_A069767
*/
void gms_A082349(SEXP s)
{
if(PAIR(s))
{
SEXP org_car = CAR(s);
if(PAIR(CDR(s))) /* We have (a . (b . rest)) */
{
SEXP org_cdr = CDR(s);
SET_CAR(s,org_cdr); /* ((b . rest) . (b . rest)) */
SET_CDR(s,CDR(org_cdr)); /* ((b . rest) . rest) */
SET_CDR(org_cdr,CAR(org_cdr)); /* ((b . b) . rest) */
SET_CAR(org_cdr,org_car); /* ((a . b) . rest) */
}
else { gms_A069767(s); }
}
}
/* Effect the change ((a . b) . rest) --> (a . (b . rest))
if car-side is a pair, otherwise apply gms_A069768
*/
void gms_A082350(SEXP s)
{
if(PAIR(s))
{
SEXP org_cdr = CDR(s);
if(PAIR(CAR(s))) /* We have ((a . b) . rest) */
{
SEXP org_car = CAR(s);
SET_CDR(s,org_car); /* ((a . b) . (a . b)) */
SET_CAR(s,CAR(org_car)); /* (a . (a . b)) */
SET_CAR(org_car,CDR(org_car)); /* (a . (b . b)) */
SET_CDR(org_car,org_cdr); /* (a . (b . rest)) */
}
else { gms_A069768(s); }
}
}
int size_of_sexp(SEXP s)
{
if(!PAIR(s)) { return(0); }
else
{
return(1+size_of_sexp(CAR(s))+size_of_sexp(CDR(s)));
}
}
void gms_A069771(SEXP s)
{
int i = size_of_sexp(s);
while(i--) { gms_A057501(s); }
}
/* To do: Implement these here:
;; Variant of A085163:
(define (gma085171! s)
(cond ((null? s) s)
(else (app-to-xrt! (gma085171! (car s))
(append! (map gma085171! (cdr s)) (list (list)))
)
)
)
)
(define A085171 (catfun1 gma085171!))
;; Define the inverse for above in dummy way, before we realize how the
;; S-expressions should be manipulated:
(definec (A085172 n) (let loop ((i 0)) (cond ((= n (A085171 i)) i) (else (loop (1+ i))))))
*/