\datethis @*Intro. Counting closure operators on six elements that are nonisomorphic under permutations. (My program for $n=5$ used a too-slow method; here I speed up by a factor of $n!$, I hope.) I wrote this in a terrific hurry---sorry. The strategy is outlined in the next section below. @d n 5 @d nn (1< @h@# char f[nn]; unsigned char perm[nfactorial][nn], iperm[nfactorial][nn]; /* perms and inverses */ int link[nfactorial]; /* links in the lists of permutations */ int wait[nn]; /* heads of those lists */ int disc[nn]; /* permutations discarded at each level */ int log0[nn], logl[nn]; /* where we began shuffling perms at each level */ int log[nfactorial*nn*2]; int logptr; /* current position in |log| table */ int forced[nn]; /* is this entry forced to be zero? */ int forcings[nfactorial]; /* how many cases has this perm forced? */ unsigned int sols,tsols; @@; main() { register int d,j,k,l,m,p,q,t,auts; @; @; @; printf("Altogether %d solutions (reduced from %d).\n",sols+1,tsols+1); } @ @= l=logptr=0; auts=nfactorial; newlevel:@+if (l==final_level) goto backtrack; logl[l]=logptr; if (verbose) { printf("Entering level %x (%d auts so far)\n",l,auts); } if (forced[l]) { if (verbose) printf(" forced rejection of %x\n",l); goto reject; } @; @; f[l]=1; if (verbose) printf(" accepting %x\n",l); @ @; l++; goto newlevel; undo: @; @; reject: f[l]=0; @; l++; goto newlevel; backtrack:@+while (l>0) { l--; if (f[l]==1) { if (verbose) printf(" now rejecting %x\n",l); goto undo; } else @; } for (p=1;p= d=nfactorial>>1, perm[d][0]=1; for (m=2;m0;k+=d,j--) perm[k][0]=j; perm[k][0]++, k+=d; for (j++;j>1; d&=m; d|=d<<1; perm[k][j]=perm[k-1][j]^d; } } for (p=0;p= for (p=1;p= for (j=0;j= { sols++; tsols+=nfactorial/auts; if (n<6) { printf("%d:",sols); for (j=0;j1?"s":""); } } @*The interesting part. When writing this program, I didn't have to work nearly as hard as I did in {\mc GROPESX} (a program for algebraic structures that I wrote a few months ago). But still there are a few nontrivial points of interest as the permutations get shuffled from list to list. In fact, I tried to get away with a more substantial simplification. It failed miserably. In actual fact, I was tearing my hair out for awhile, because I couldn't believe that this would be so complicated. Maybe some day I'll learn the right way to tackle this problem. @ The basic idea is simple: Each closure operation corresponds to a sequence $(f[0],\ldots,f[|nn|-2])$ with the property that $f[j]=f[k]=1$ implies $f[j\AND k]=1$. This program produces only canonical solutions, namely solutions with the property that $(f[0],\ldots,f[|nn|-1])$ is lexicographically greater than or equal to $(f[p_0],\ldots,f[p_{nn-1}])$ for all perms $p$. (These perms are permutations of the bits; for example, if $p_1=2$ and $p_2=4$ then $p_3=6$.) At level |l|, I've set the values of $(f[0],\ldots,f[l-1])$. All perms live in various lists: If $(f[0],\ldots,f[l-1])$ is known to be lexicographically greater than $(f[p_0],\ldots,f[p_{l-1}])$, the perm~$p$ is in a discard list; otherwise $p$ is in a waiting list. List |wait[0]| has all the current automorphisms: These perms permute the current 1s $\{j\mid 0\le jl$, the future values $p_k$ are marked so as to force $f[p_k]=0$. Finally, the waiting lists |wait[k]| for $l\le k=log0[l]|, otherwise from |wait[l]|. @= for (p=wait[l],wait[l]=0;p;p=q) { q=link[p]; for (k=iperm[p][l]+1;k; log[logptr++]=-j,link[p]=disc[l],disc[l]=p; /* discard |p| */ goto nextp; }@+else if (f[k]==1) { log[logptr++]=j,link[p]=wait[j],wait[j]=p; for (j=k-1;j>iperm[p][l];j--) if (f[j]==0 && perm[p][j]>k && perm[p][j]= log0[l]=logptr; for (auts=1,p=wait[0],wait[0]=0;p;p=q) { q=link[p]; j=perm[p][l]; if (j==l) goto retain_it; else if (j>l) log[logptr++]=j,link[p]=wait[j],wait[j]=p; else if (f[j]==0) log[logptr++]=-1,link[p]=disc[l],disc[l]=p; else goto retain_it; continue; retain_it: log[logptr++]=0,link[p]=wait[0],wait[0]=p; auts++; } @ Here I've made a point to undo'' in precisely the reverse order of what I did,'' so that lists are perfectly restored to their former condition. The label |kludge| is one of my trademarks, I guess: It's a place in the middle of nested loops, which just happens to be the place we want to jump when doing an immediate rejection. @= t=0; while (logptr>logl[l]) { j=log[--logptr]; if (j<0) { p=disc[l],disc[l]=link[p],k=iperm[p][-j]; if (f[k]==0 && iperm[p][k]0) { p=wait[j],wait[j]=link[p],k=iperm[p][j]; for (j=k-1;j>iperm[p][l];j--) if (f[j]==0 && perm[p][j]>k && perm[p][j]iperm[p][l]) { j=perm[p][k]; if (j>l && f[k]==0) forcings[p]--,forced[j]--; kludge:@+ if (f[k]==0 && iperm[p][k]= { t=p; goto kludge; } @ @= t=0; while (logptr>log0[l]) { j=log[--logptr]; if (j<0) p=disc[l],disc[l]=link[p]; else p=wait[j],wait[j]=link[p]; link[p]=t,t=p; } wait[0]=t; @ @= for (auts=1,p=wait[0];p;p=link[p]) { j=perm[p][l]; if (j>l) { if (verbose) printf(" forcing f[%x]=0\n",j); forcings[p]++,forced[j]++; } if (iperm[p][l]= for (p=wait[0];p;p=link[p]) { j=perm[p][l]; if (j>l) { forcings[p]--,forced[j]--; } if (iperm[p][l]= int timestamp; int stamp[nfactorial]; void sanity(int l) { register c,j,jj,k,p; if (l==0) return; timestamp++; @; @; @; for (p=1;p= for (k=l;kjj) { if (f[j]==0) c++; else if (perm[p][j]==k) break; }@+else if (f[j]!=f[perm[p][j]]) { printf("error: perm %d on wait[%x] contains early mismatch f[%x]!=f[%x]!\n", p,k,j,perm[p][j]); goto error_exit; } } if (c!=forcings[p]) { printf("error: forcings[%d] is %d, not %d, in wait[%x]!\n", p,forcings[p],c,k); goto error_exit; } } @ The wait lists |wait[k]| for$1\le k= for (k=1;kjj && f[j]==0) c++; if (c!=forcings[p]) { printf("error: forcings[%d] is %d, not %d, in wait[%x]!\n", p,forcings[p],c,k); goto error_exit; } } } @ @= for (p=wait[0];p;p=link[p]) { stamp[p]=timestamp; for (c=j=0;j=l) c++; } if (c!=forcings[p]) { printf("error: forcings[%d] is %d, not %d, in wait[0]!\n", p,forcings[p],c); goto error_exit; } } @*Index.