/* 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));
}