Metropoli BBS
VIEWER: cat.c MODE: TEXT (ASCII)
/* 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));
}
[ RETURN TO DIRECTORY ]