/* Copyright (C) 1993 by Thomas Glen Smith. All Rights Reserved. */ /* cat APL2 V1.0.0 ***************************************************** * Catenates two arguments that are some combination of scalars, * * vectors, and arrays, to produce a single vector or array. The * * restrictions are: * * 1. A nonempty numeric vector can't be catenated with a nonempty * * character vector. * * 2. If neither argument has rank > 1 the axis argument is ignored. * * Otherwise the axis argument determines along which dimension * * elements are to be catenated. If axis<0, the default of the * * last axis will be assumed. * * 3. If the axis argument applies, then the two array arguments must * * be conformable. That is, they must differ in rank by no more * * than one, and may be catenated along axis I if all other * * elements in their shapes agree. * * 4. A scalar argument will be replicated as required to be * * conformable. * ***********************************************************************/ #define INCLUDES APLCB #include "includes.h" Aplcb cat(left,rite,axis) Aplcb left,rite; int axis; { Catlamcm; Conform; Dtacopy; Errstop; Getcb; Imax; Intcopy; Matchok; extern int aplerr, indxorg; Aplcb big, lit, out=NULL; union apluptr lp,op,rp; int axicnt,bigcnt,botcnt,datacnt,datatyp,*dimptr,i,j,k, leftcnt,leftincr,litaxc,litcnt,rank,ritecnt,riteincr,topcnt; if (!matchok(&left,&rite,APLMASK+APLAPL)) return(NULL); if (axis < 0) /* does caller want the default axis? */ axis = imax(left->aplrank,rite->aplrank); else axis += (indxorg==0); if (OK != conform(left,rite,axis,&big,&lit)) return(errstop(2,left,rite,NULL)); /* not conformable */ if (OK!=axispre(big,axis,&axicnt,&botcnt,&topcnt)) return(errstop(0,left,rite,NULL)); rank=imax(1,big->aplrank); if ((lit->aplrank != big->aplrank) || lit->aplrank==0) litaxc=1; else litaxc=*(lit->apldim+axis-1); bigcnt=axicnt*botcnt; litcnt=litaxc*botcnt; if (left == big) { leftcnt=bigcnt; ritecnt=litcnt; } else { leftcnt=litcnt; ritecnt=bigcnt; } datacnt=topcnt*(leftcnt+ritecnt); datatyp=big->aplflags & (APLMASK+APLAPL); out=getcb(NULL,datacnt,datatyp+APLTEMP,rank,NULL); if (rank>1) { dimptr=intcopy(out->apldim,big->apldim,rank,1); *(out->apldim+axis-1)+=litaxc; } if (datacnt) return(catlamcm(left,rite,out,axis, axicnt,botcnt,topcnt,leftcnt,ritecnt)); return(errstop(0,left,rite,out)); }