Newsgroups: comp.lang.apl
Path: watmath!watserv2.uwaterloo.ca!torn!utnut!cs.utexas.edu!math.ohio-state.edu!howland.reston.ans.net!europa.eng.gtefsd.com!emory!news-feed-1.peachnet.edu!umn.edu!csus.edu!sfsuvax1.sfsu.edu!vpcsc4
From: vpcsc4@sfsuvax1.sfsu.edu (Emmett McLean)
Subject: Combinations as primitives
Message-ID: <1993Jun4.203814.24818@csus.edu>
Sender: news@csus.edu
Organization: San Francisco State University
Date: Fri, 4 Jun 1993 20:38:14 GMT
Lines: 164


The programs below implement combinations generators as
20!: foreign conjunctions in J. 

This program is a bit cleaner and better thought out
than the previous combinations verb I posted which used LinkJ.

-Emmett

#!/bin/sh
# This is a shell archive (produced by shar 3.50)
# To extract the files from this archive, save it to a file, remove
# everything above the "!/bin/sh" line above, and type "sh file_name".
#
# made 06/04/1993 19:02 UTC by emclean@sfsuvax1.sfsu.edu
# Source directory /usr/s3/emclean/src
#
# existing files will NOT be overwritten unless -c is specified
#
# This shar contains:
# length  mode       name
# ------ ---------- ------------------------------------------
#    555 -rw------- readme
#   2217 -rw------- cb.c
#    393 -rw------- comb.js
#
# ============= readme ==============
if test -f 'readme' -a X"$1" != X"-c"; then
	echo 'x - skipping readme (File already exists)'
else
echo 'x - extracting readme (Text)'
sed 's/^X//' << 'SHAR_EOF' > 'readme' &&
X 
X Primitive combinations verbs for J.
X
X The program providing the basis for these verbs was 
X written by Bob Craig kat3@ihlpe.att.com . (Thanks)
X
X Attached are:
X 0. readme   - This file.
X 1. comb.js  - J script for usages
X 2. cb.c     - C programs
X
X Installation 
X
X  0. change the line :
X  
X     ASSERT(0,EVDOMAIN);
X  
X     in x.c to :
X  
X     if(20==p){AF*f1,*f2;
X      ASSERT(jcob(q,&f1,&f2),EVDOMAIN);
X     R CDERIV(CIBEAM, f1,f2, RMAXL,RMAXL,RMAXL);}
X     ASSERT(0,EVDOMAIN);
X     }
X
X 1. change OBS in the makefile to include cb.o
X  
X    Then make. 
SHAR_EOF
chmod 0600 readme ||
echo 'restore of readme failed'
Wc_c="`wc -c < 'readme'`"
test 555 -eq "$Wc_c" ||
	echo 'readme: original size 555, current size' "$Wc_c"
fi
# ============= cb.c ==============
if test -f 'cb.c' -a X"$1" != X"-c"; then
	echo 'x - skipping cb.c (File already exists)'
else
echo 'x - extracting cb.c (Text)'
sed 's/^X//' << 'SHAR_EOF' > 'cb.c' &&
/* ----------------------------------------------------------------------- */
/*                                                                         */
/* Bob Craig's combinations program                                        */
/* interfaced with J by emclean@vax1.sfsu.edu                              */
X
#include "j.h"
#define DOIJ(n,a,m,w){I i=0,_n=(n),_m=(m);for(;i<_n;i++){{a;}for(j=0;j<_m;j++){w;}}}
#define DOIFDO(n,a,w,m,z){I i=0,_n=(n),_m=(m);for(;i<_n;i++){{a;}if((w))for(j=0;j<_m;j++){z;}}} 
X
I ncomb(com,n,m) I*com,n,m;{I k,ka,kb;
X	for(k=0;k<m;k++){ka=m-k-1;kb=n-k-1;if(com[ka]<kb)break;} 
X	if(k==m){for(k=0;k<m;k++)com[k]=k;}
X	else{kb=com[ka];for(k=ka;k<m;k++)com[k]=++kb;}
X	R 0 ;
}
static F2(cmb0){PROLOG;A z,com;
X     I*pz,nn,mm,in,nm,i,j;
X     F2RANK(0,0,cmb0,0);RZ(a&&w);
X     ASSERT((BOOL+INT)&AT(w),EVDOMAIN);
X     nn=i0(w);mm=i0(a);nm=i0(outof(sc(mm),sc(nn)));
X     z=reshape(v2(nm,mm),sc(0));pz=AV(z);
X     com=reshape(sc(mm),sc(0));
X     DO(mm,AV(com)[i]=nn-1;);
X	 DOIJ(nm,ncomb(AV(com),nn,mm),mm,*pz++=AV(com)[j]);
X     EPILOG(z);
}
static F2(cmb1){PROLOG;A z,a0,a1,t0,t1,bl,co,mb,com;
X	I*pz,nn,mm,in,nm,i,j;B*pb;RZ(a&&w);
X     F2RANK(1,1,cmb1,0);
X     ASSERT(BOX&AT(a),EVDOMAIN);ASSERT(AN(a)==2,EVDOMAIN); 
X     a0=ope(from(sc(0),a));a1=ope(from(sc(1),a));
X     ASSERT((BOOL+INT)&AT(a0),EVDOMAIN);ASSERT(AR(a0)<=1,EVRANK);  
X     ASSERT((BOOL+INT)&AT(a1),EVDOMAIN);ASSERT(AR(a1)==0,EVRANK); 
X     mm=i0(a1);nn=i0(tally(w));ASSERT(mm<=nn,EVDOMAIN);
X     in=i0(df1(a0,slash(ds(CCEIL))));co=outof(sc(mm),sc(nn));
X     ASSERT(in<i0(co),EVDOMAIN);mb=nub(a0);bl=eps(iota(co),mb);
X     z=reshape(v2(AN(mb),mm),sc(0));pz=(I*)AV(z);pb=(B*)AV(bl); 
X     com=reshape(sc(mm),sc(0));DO(mm,AV(com)[i]=nn-1;);
X     DOIFDO((in+1),ncomb(AV(com),nn,mm),1==*pb++,mm,*pz++=AV(com)[j]);
X     /* Model is (((/:~ i. ]) l) f (+/@(] =/ ~.)@/:~ l) # z  f w */
X     t1=grade2(a0,a0); t0=indexof(t1,a0);
X     t1=df1(df2(t1,mb,slash(ds(CEQ))),slash(ds(CPLUS)));
X     EPILOG(from(from(t0,repeat(t1,z)),w));
}
static F2(jcober){ASSERT(0,EVDOMAIN);}
C jcob(k,f1,f2)I k;AF*f1,*f2;
{ switch(k){
X  case 0: *f1=jcober; *f2=cmb0; R 1;    
X  case 1: *f1=jcober; *f2=cmb1; R 1;    
X  default: ASSERT(0,EVNONCE);       
X  }
}
SHAR_EOF
chmod 0600 cb.c ||
echo 'restore of cb.c failed'
Wc_c="`wc -c < 'cb.c'`"
test 2217 -eq "$Wc_c" ||
	echo 'cb.c: original size 2217, current size' "$Wc_c"
fi
# ============= comb.js ==============
if test -f 'comb.js' -a X"$1" != X"-c"; then
	echo 'x - skipping comb.js (File already exists)'
else
echo 'x - extracting comb.js (Text)'
sed 's/^X//' << 'SHAR_EOF' > 'comb.js' &&
comb0 =. 20!:0
comb1 =. 20!:1
test =. 6!:2,7!:2@]
X
NB. Example usages
3 comb0 5
((|.i.10);3) comb1 'abcdef'
((i.10);3) comb1 'abcdef'
(3;3) comb1 'abcdef'
((i.3);3) comb1 i. 5
X
NB. Compare to indigenous version
b =.(([$:<:@]),(2&^@<:@]+<:@[$:<:@]))`(#.@(]#1:))`0: @.(#.@(0&=@[,(=])))
comb2 =. ( #:@( b ]) #"1 i.@] ) :: (''"_)
X
test =. 6!:2,7!:2@]
test 'c =. 3 comb0 13'
test 'c =. 3 comb2 13'
SHAR_EOF
chmod 0600 comb.js ||
echo 'restore of comb.js failed'
Wc_c="`wc -c < 'comb.js'`"
test 393 -eq "$Wc_c" ||
	echo 'comb.js: original size 393, current size' "$Wc_c"
fi
exit 0
