The R Project SVN – R – Diff – /trunk/src/main/array.c



 
	lendat = length(vals);
	nr = asInteger(snr);
	nc = asInteger(snc);
 
 
	if( lendat != 1 && (nr*nc) % lendat != 0 ) {
		if( ((lendat>nr) && (lendat/nr)*nr != lendat ) ||
			((lendat< nr) && (nr/lendat) * lendat != nr ))
			warning("Replacement length not a multiple of the elements to replace in matrix(...) \n");
		else if( ((lendat>nc) && (lendat/nc)*nc != lendat ) ||
			((lendat< nc) && (nc/lendat) * lendat != nc ))
			warning("Replacement length not a multiple of the elements to replace in matrix(...) \n");

		copyVector(ans, vals);
		UNPROTECT(2);
		return ans;
	}
	else error("bad arguments to array\n");
	return call;/* never used; just for -Wall */
}
 
SEXP allocArray(SEXPTYPE mode, SEXP dims)
{
	SEXP array;

					goto next_ik;
#endif
				sum += xij * yjk;
			}
			z[i + k * nrx] = sum;
#ifndef IEEE_754
		next_ik:
			;
#endif
		}
}
 
static void cmatprod(complex *x, int nrx, int ncx,
		complex *y, int nry, int ncy, complex *z)

				sum_r += (xij_r * yjk_r - xij_i * yjk_i);
				sum_i += (xij_r * yjk_i + xij_i * yjk_r);
			}
			z[i+k*nrx].r = sum_r;
			z[i+k*nrx].i = sum_i;
#ifndef IEEE_754
		next_ik:
			;
#endif
		}
}
 
static void crossprod(double *x, int nrx, int ncx, double *y, int nry, int ncy, double *z)
{

					goto next_ik;
#endif
				sum += xji * yjk;
			}
			z[i + k * ncx] = sum;
#ifndef IEEE_754
		next_ik:
			;
#endif
		}
}
 
static void ccrossprod(complex *x, int nrx, int ncx, complex *y, int nry, int ncy, complex *z)
{

				sum_r += (xji_r * yjk_r - xji_i * yjk_i);
				sum_i += (xji_r * yjk_i + xji_i * yjk_r);
			}
			z[i + k * ncx].r = sum_r;
			z[i + k * ncx].i = sum_i;
#ifndef IEEE_754
		next_ik:
			;
#endif
		}
}
 
SEXP do_matprod(SEXP call, SEXP op, SEXP args, SEXP rho)
{

}
 
SEXP do_transpose(SEXP call, SEXP op, SEXP args, SEXP rho)
{
	SEXP a, r, dims, dn;
	int i, len=0, ncol=0, nrow=0;
 
	checkArity(op, args);
	a = CAR(args);
 
	if(isVector(a)) {

	UNPROTECT(1);
	return r;
 
not_matrix:
	errorcall(call, "argument is not a matrix\n");
	return call;/* never used; just for -Wall */
}
 
 
	/* swap works by finding for a index i, the position */
	/* in the array with dimensions dims1 in terms of */

Rev 968	Rev 1016
Line 51...	Line 51...
51		51
52	`lendat = length(vals);`	52	`lendat = length(vals);`
53	`nr = asInteger(snr);`	53	`nr = asInteger(snr);`
54	`nc = asInteger(snc);`	54	`nc = asInteger(snc);`
55		55
56		56
57	`if( lendat != 1 && (nr*nc) % lendat != 0 ) {`	57	`if( lendat != 1 && (nr*nc) % lendat != 0 ) {`
58	`if( ((lendat>nr) && (lendat/nr)*nr != lendat ) \|\|`	58	`if( ((lendat>nr) && (lendat/nr)*nr != lendat ) \|\|`
59	`((lendat< nr) && (nr/lendat) * lendat != nr ))`	59	`((lendat< nr) && (nr/lendat) * lendat != nr ))`
60	`warning("Replacement length not a multiple of the elements to replace in matrix(...) \n");`	60	`warning("Replacement length not a multiple of the elements to replace in matrix(...) \n");`
61	`else if( ((lendat>nc) && (lendat/nc)*nc != lendat ) \|\|`	61	`else if( ((lendat>nc) && (lendat/nc)*nc != lendat ) \|\|`
62	`((lendat< nc) && (nc/lendat) * lendat != nc ))`	62	`((lendat< nc) && (nc/lendat) * lendat != nc ))`
63	`warning("Replacement length not a multiple of the elements to replace in matrix(...) \n");`	63	`warning("Replacement length not a multiple of the elements to replace in matrix(...) \n");`
Line 108...	Line 108...
108	`copyVector(ans, vals);`	108	`copyVector(ans, vals);`
109	`UNPROTECT(2);`	109	`UNPROTECT(2);`
110	`return ans;`	110	`return ans;`
111	`}`	111	`}`
112	`else error("bad arguments to array\n");`	112	`else error("bad arguments to array\n");`
-		113	`return call;/* never used; just for -Wall */`
113	`}`	114	`}`
114		115
115	`SEXP allocArray(SEXPTYPE mode, SEXP dims)`	116	`SEXP allocArray(SEXPTYPE mode, SEXP dims)`
116	`{`	117	`{`
117	`SEXP array;`	118	`SEXP array;`
Line 334...	Line 335...
334	`goto next_ik;`	335	`goto next_ik;`
335	`#endif`	336	`#endif`
336	`sum += xij * yjk;`	337	`sum += xij * yjk;`
337	`}`	338	`}`
338	`z[i + k * nrx] = sum;`	339	`z[i + k * nrx] = sum;`
-		340	`#ifndef IEEE_754`
339	`next_ik:`	341	`next_ik:`
340	`;`	342	`;`
-		343	`#endif`
341	`}`	344	`}`
342	`}`	345	`}`
343		346
344	`static void cmatprod(complex *x, int nrx, int ncx,`	347	`static void cmatprod(complex *x, int nrx, int ncx,`
345	`complex y, int nry, int ncy, complex z)`	348	`complex y, int nry, int ncy, complex z)`
Line 366...	Line 369...
366	`sum_r += (xij_r * yjk_r - xij_i * yjk_i);`	369	`sum_r += (xij_r * yjk_r - xij_i * yjk_i);`
367	`sum_i += (xij_r * yjk_i + xij_i * yjk_r);`	370	`sum_i += (xij_r * yjk_i + xij_i * yjk_r);`
368	`}`	371	`}`
369	`z[i+k*nrx].r = sum_r;`	372	`z[i+k*nrx].r = sum_r;`
370	`z[i+k*nrx].i = sum_i;`	373	`z[i+k*nrx].i = sum_i;`
-		374	`#ifndef IEEE_754`
371	`next_ik:`	375	`next_ik:`
372	`;`	376	`;`
-		377	`#endif`
373	`}`	378	`}`
374	`}`	379	`}`
375		380
376	`static void crossprod(double x, int nrx, int ncx, double y, int nry, int ncy, double *z)`	381	`static void crossprod(double x, int nrx, int ncx, double y, int nry, int ncy, double *z)`
377	`{`	382	`{`
Line 390...	Line 395...
390	`goto next_ik;`	395	`goto next_ik;`
391	`#endif`	396	`#endif`
392	`sum += xji * yjk;`	397	`sum += xji * yjk;`
393	`}`	398	`}`
394	`z[i + k * ncx] = sum;`	399	`z[i + k * ncx] = sum;`
-		400	`#ifndef IEEE_754`
395	`next_ik:`	401	`next_ik:`
396	`;`	402	`;`
-		403	`#endif`
397	`}`	404	`}`
398	`}`	405	`}`
399		406
400	`static void ccrossprod(complex x, int nrx, int ncx, complex y, int nry, int ncy, complex *z)`	407	`static void ccrossprod(complex x, int nrx, int ncx, complex y, int nry, int ncy, complex *z)`
401	`{`	408	`{`
Line 421...	Line 428...
421	`sum_r += (xji_r * yjk_r - xji_i * yjk_i);`	428	`sum_r += (xji_r * yjk_r - xji_i * yjk_i);`
422	`sum_i += (xji_r * yjk_i + xji_i * yjk_r);`	429	`sum_i += (xji_r * yjk_i + xji_i * yjk_r);`
423	`}`	430	`}`
424	`z[i + k * ncx].r = sum_r;`	431	`z[i + k * ncx].r = sum_r;`
425	`z[i + k * ncx].i = sum_i;`	432	`z[i + k * ncx].i = sum_i;`
-		433	`#ifndef IEEE_754`
426	`next_ik:`	434	`next_ik:`
427	`;`	435	`;`
-		436	`#endif`
428	`}`	437	`}`
429	`}`	438	`}`
430		439
431	`SEXP do_matprod(SEXP call, SEXP op, SEXP args, SEXP rho)`	440	`SEXP do_matprod(SEXP call, SEXP op, SEXP args, SEXP rho)`
432	`{`	441	`{`
Line 552...	Line 561...
552	`}`	561	`}`
553		562
554	`SEXP do_transpose(SEXP call, SEXP op, SEXP args, SEXP rho)`	563	`SEXP do_transpose(SEXP call, SEXP op, SEXP args, SEXP rho)`
555	`{`	564	`{`
556	`SEXP a, r, dims, dn;`	565	`SEXP a, r, dims, dn;`
557	`int i, len, ncol, nrow;`	566	`int i, len=0, ncol=0, nrow=0;`
558		567
559	`checkArity(op, args);`	568	`checkArity(op, args);`
560	`a = CAR(args);`	569	`a = CAR(args);`
561		570
562	`if(isVector(a)) {`	571	`if(isVector(a)) {`
Line 635...	Line 644...
635	`UNPROTECT(1);`	644	`UNPROTECT(1);`
636	`return r;`	645	`return r;`
637		646
638	`not_matrix:`	647	`not_matrix:`
639	`errorcall(call, "argument is not a matrix\n");`	648	`errorcall(call, "argument is not a matrix\n");`
-		649	`return call;/* never used; just for -Wall */`
640	`}`	650	`}`
641		651
642		652
643	`/* swap works by finding for a index i, the position */`	653	`/* swap works by finding for a index i, the position */`
644	`/* in the array with dimensions dims1 in terms of */`	654	`/* in the array with dimensions dims1 in terms of */`

The R Project SVN R

(root)/trunk/src/main/array.c @ 28362 – Rev 968 → 1016