Newsgroups: comp.lang.apl
Path: watmath!watserv2.uwaterloo.ca!torn!howland.reston.ans.net!darwin.sura.net!news-feed-1.peachnet.edu!umn.edu!csus.edu!sfsuvax1.sfsu.edu!vpcsc4
From: vpcsc4@sfsuvax1.sfsu.edu (Emmett McLean)
Subject: LinkJ combinations hack for J
Message-ID: <1993May26.023130.4553@csus.edu>
Sender: news@csus.edu
Organization: San Francisco State University
Date: Wed, 26 May 1993 02:31:30 GMT
Lines: 173


Here is a 10!:0 LinkJ hack for generating combinations.
When the left and right arguments, m and n of 10!:0 are atomic
integers, n 10!:0 m returns the n choose m combinations of i. n .
For example :

   3 (10!:0) 5
0 1 2
0 1 3
0 1 4
0 2 3
0 2 4
0 3 4
1 2 3
1 2 4
1 3 4
2 3 4

If the left arugment of is a boxed noun 10!:0 works much like
A. That is, (p;m)10!:0(i.n) produces the n choose m combinations of 
i. n indexed by the list p. For example :

   ((i. 4) ;2) 10!:0 ('abcde')
ab
ac
ad
ae
   ((|. i. 4) ; 2) 10!:0 ('abcde')
ae
ad
ac
ab

This hack is pretty fast.  Note that :
   8 ! 20
125970
   test =. 6!:2 , 7!:2@]
   test '8 (10!:0) 20'
15.74 8.06272e6
   test '8 (10!:0) 20'
4.7 8.06276e6 

So it runs even faster the second time around.
 
I named the file with the combinations routine, ncomb, cb.c
 
If you find a bug, especially something which invokes
a core dump I'd like to be informed about it.

Comments about programming style are also welcome.
I still haven't figured why I have to cast the results
of most function calls.

This has been tested on the VAX ULTRIX and the NeXT with
gcc and objective c respectively.

As I get better at hacking the source I may return to this
and rewrite it.

The original combinations program was coded by :

	  Programmer:  Robert J. Craig
			AT&T Bell Labs
			(312) 979-1822

Robert was kind enough to provide this code.
No royalties required.

----------main.c------------------------
#include <stdio.h>
#include <string.h>
#include "lj.h"
#include <math.h>
#include "jc.h"
#define DO(n,x){I i=0,_n=(n);for(;i<_n;i++){x;}}
#define DOIJ(n,x,m,y)  {I i=0,_n=(n),_m=(m);for(;i<_n;i++){{x;}for(j=0;j<_m;j++){y;}}}
#define DOIFDO(n,x,y,m,z){I i=0,_n=(n),_m=(m);for(;i<_n;i++){{x;}if((y))for(j=0;j<_m;j++){z;}}} 
#define IAV(x) (I)*AV(x)

static F2(comb){ A z,x0,x1,t0,t1,bl,co,mb;
	I *com, *pz, nn, mm, in, nm, i, j ; B *pb;
	if((BOOL+INT)&AT(x)){
    ASSERT((BOOL+INT)&AT(y),EVDOMAIN);
    ASSERT(AR(x)==0&&AR(y)==0,EVRANK);
    nn=IAV(y);
    mm=IAV(x);
    nm=IAV((A)outof(x,y));
    z=(A)reshape(v2(nm,mm),jma(INT,nm*mm,2L)); 
    pz=AV(z);
    com=(I*)malloc(mm*sizeof(I*)); 
	DO(mm,com[i]=nn-1);
	DOIJ(nm,ncomb(com,nn,mm),mm,*pz++=com[j];);
    free(com);
    R(z);
    }
    else {
    ASSERT(BOX&AT(x),EVDOMAIN);
    ASSERT(AN(x)==2,EVDOMAIN); 
    x0=(A)ope(from(sc(0),x));
    ASSERT((BOOL+INT)&AT(x0),EVDOMAIN);
    ASSERT(AR(x0)<=1,EVRANK);  
    x1=(A)ope(from(sc(1),x));
    ASSERT((BOOL+INT)&AT(x1),EVDOMAIN);
    ASSERT(AR(x1)==0,EVRANK); 
    mm=IAV((A)x1);
    nn=IAV((A)tally(y));
    ASSERT(mm<=nn,EVDOMAIN);
    in=IAV((A)df1(x0,slash(ds(CCEIL))));
    co=(A)outof(sc(mm),sc(nn));
    ASSERT(in<IAV(co),EVDOMAIN);
    mb=(A)nub(x0);
    bl=(A)eps(iota(co),mb);
    z=jma(INT,AN(mb)*mm,2L);
    z=(A)reshape(v2(AN(mb),mm),z);
    pz=(I*)AV(z);
    pb=(B*)AV(bl); 
    com=(I*)malloc(mm*sizeof(I*)); 
    DO(mm,com[i]=nn-1);
    DOIFDO((in+1),ncomb(com,nn,mm),1==*pb++,mm,*pz++=com[j]);
    /* Model is (((/:~ i. ]) x0) { (+/@(] =/ ~.)@/:~ x0) # z  { y */
    t1=(A)grade2(x0,x0);
    t0=(A)indexof(t1,x0);
    t1=(A)df1(df2(t1,mb,slash(ds(CEQ))),slash(ds(CPLUS)));
    z=(A)from(from(t0,repeat(t1,z)),y);
    free(com);
    R(z);
  }
}


C jc(k,f1,f2)I k;AF*f1,*f2;
{ switch(k){
  case 0:
   *f1=NULL;                    /* monad of 10!:0                          */
   *f2=comb;                     /* dyad  of 10!:0                          */
   R 1;                         /* indicate no error                       */
  default:
   ASSERT(0,EVNONCE);           /* 10!:k where k is not 0. error for now.  */
  }
}

main()
{A t;C s[456];
 jinit();
 while(1)
 {
  printf("   ");
  if(NULL==gets(s)||'\004'==*(s+strlen(s)-1))exit(0);
  t=jx(s);
  if(jerr)printf("jerr: %d\n",jerr); else if(!asgn)jpr(t);
 }
}
---------cb.c-----------
int ncomb(com, n, m)
int *com, n, m;
{ /* originally coded by Bob Craig at AT&T */
	int k, ka, kb;
	for (k=0; k<m; k++) {
		ka = m - k - 1;
		kb = n - k - 1;
		if (com[ka] < kb)
			break;
	}
	if (k == m) {
		for (k=0; k<m; k++)
			com[k] = k;
	} else {
		kb = com[ka];
		for (k=ka; k<m; k++)
			com[k] = ++kb;
	}
	return(0);
}
