The R Project SVN R

Rev

Rev 1016 | Rev 1073 | Go to most recent revision | Show entire file | Ignore whitespace | Details | Blame | Last modification | View Log | RSS feed

Rev 1016 Rev 1026
Line 62... Line 62...
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");
64 
	}
 64 
	}
65 
 
 65 
 
66 
	PROTECT(snr = allocMatrix(TYPEOF(vals), nr, nc));
 66 
	PROTECT(snr = allocMatrix(TYPEOF(vals), nr, nc));
67 
	LEVELS(snr) = LEVELS(vals);
 - 
 
68 
	if(isVector(vals))
 67 
	if(isVector(vals))
69 
		copyMatrix(snr, vals, byrow);
 68 
		copyMatrix(snr, vals, byrow);
70 
	else
 69 
	else
71 
		copyListMatrix(snr, vals, byrow);
 70 
		copyListMatrix(snr, vals, byrow);
72 
	UNPROTECT(1);
 71 
	UNPROTECT(1);
Line 102... Line 101...
102 
 
 101 
 
103 
	if (isVector(vals) && isNumeric(dims) && LENGTH(dims) >= 2) {
 102 
	if (isVector(vals) && isNumeric(dims) && LENGTH(dims) >= 2) {
104 
		PROTECT(dims = coerceVector(dims, INTSXP));
 103 
		PROTECT(dims = coerceVector(dims, INTSXP));
105 
		CheckDims(dims);
 104 
		CheckDims(dims);
106 
		PROTECT(ans = allocArray(TYPEOF(vals), dims));
 105 
		PROTECT(ans = allocArray(TYPEOF(vals), dims));
107 
		LEVELS(ans) = LEVELS(vals);
 - 
 
108 
		copyVector(ans, vals);
 106 
		copyVector(ans, vals);
109 
		UNPROTECT(2);
 107 
		UNPROTECT(2);
110 
		return ans;
 108 
		return ans;
111 
	}
 109 
	}
112 
	else error("bad arguments to array\n");
 110 
	else error("bad arguments to array\n");
Line 232... Line 230...
232 
	/* Length of Primitive Objects */
 230 
	/* Length of Primitive Objects */
233 
 
 231 
 
234 
SEXP do_length(SEXP call, SEXP op, SEXP args, SEXP rho)
 232 
SEXP do_length(SEXP call, SEXP op, SEXP args, SEXP rho)
235 
{
 233 
{
236 
	SEXP ans;
 234 
	SEXP ans;
237 
 
 - 
 
238 
	if (length(args) != 1)
 235 
	if (length(args) != 1)
239 
		error("incorrect number of args to length\n");
 236 
		error("incorrect number of args to length\n");
240 
 
 - 
 
241 
	ans = allocVector(INTSXP, 1);
 237 
	ans = allocVector(INTSXP, 1);
242 
 
 - 
 
243 
#ifdef OLD
 - 
 
244 
	switch(TYPEOF(CAR(args))) {
 - 
 
245 
	    case NILSXP:
 - 
 
246 
		INTEGER(ans)[0] = 0;
 - 
 
247 
		break;
 - 
 
248 
	    case LGLSXP:
 - 
 
249 
	    case FACTSXP:
 - 
 
250 
	    case ORDSXP:
 - 
 
251 
	    case INTSXP:
 - 
 
252 
	    case REALSXP:
 - 
 
253 
	    case CPLXSXP:
 - 
 
254 
	    case STRSXP:
 - 
 
255 
	    case EXPRSXP:
 - 
 
256 
		INTEGER(ans)[0] = LENGTH(CAR(args));
 - 
 
257 
		break;
 - 
 
258 
	    case LISTSXP:
 - 
 
259 
	    case LANGSXP:
 - 
 
260 
		INTEGER(ans)[0] = length(CAR(args));
 - 
 
261 
		break;
 - 
 
262 
	    case ENVSXP:
 - 
 
263 
		INTEGER(ans)[0] = length(FRAME(CAR(args)));
 - 
 
264 
		break;
 - 
 
265 
	    default:
 - 
 
266 
		INTEGER(ans)[0] = 1;
 - 
 
267 
		break;
 - 
 
268 
	}
 - 
 
269 
#else
 - 
 
270 
	INTEGER(ans)[0] = length(CAR(args));
 238 
	INTEGER(ans)[0] = length(CAR(args));
271 
#endif
 - 
 
272 
	return ans;
 - 
 
273 
}
 - 
 
274 
 
 - 
 
275 
SEXP do_nlevels(SEXP call, SEXP op, SEXP args, SEXP rho)
 - 
 
276 
{
 - 
 
277 
	SEXP ans;
 - 
 
278 
 
 - 
 
279 
	checkArity(op, args);
 - 
 
280 
	ans = allocVector(INTSXP, 1);
 - 
 
281 
	if (isFactor(CAR(args)))
 - 
 
282 
		INTEGER(ans)[0] = LEVELS(CAR(args));
 - 
 
283 
	else
 - 
 
284 
		INTEGER(ans)[0] = NA_INTEGER;
 - 
 
285 
	return ans;
 239 
	return ans;
286 
}
 240 
}
287 
 
 241 
 
288 
 
 242 
 
289 
SEXP do_rowscols(SEXP call, SEXP op, SEXP args, SEXP rho)
 243 
SEXP do_rowscols(SEXP call, SEXP op, SEXP args, SEXP rho)
Line 596... Line 550...
596 
 
 550 
 
597 
	PROTECT(r = allocVector(TYPEOF(a), len));
 551 
	PROTECT(r = allocVector(TYPEOF(a), len));
598 
 
 552 
 
599 
	switch (TYPEOF(a)) {
 553 
	switch (TYPEOF(a)) {
600 
	case LGLSXP:
 554 
	case LGLSXP:
601 
	case FACTSXP:
 - 
 
602 
	case ORDSXP:
 - 
 
603 
	case INTSXP:
 555 
	case INTSXP:
604 
		for (i = 0; i < len; i++)
 556 
		for (i = 0; i < len; i++)
605 
			INTEGER(r)[i] = INTEGER(a)[(i / ncol) + (i % ncol) * nrow];
 557 
			INTEGER(r)[i] = INTEGER(a)[(i / ncol) + (i % ncol) * nrow];
606 
		break;
 558 
		break;
607 
	case REALSXP:
 559 
	case REALSXP:
Line 706... Line 658...
706 
	PROTECT(ind1 = allocVector(INTSXP, LENGTH(dimsa)));
 658 
	PROTECT(ind1 = allocVector(INTSXP, LENGTH(dimsa)));
707 
	PROTECT(ind2 = allocVector(INTSXP, LENGTH(dimsa)));
 659 
	PROTECT(ind2 = allocVector(INTSXP, LENGTH(dimsa)));
708 
 
 660 
 
709 
	switch (TYPEOF(a)) {
 661 
	switch (TYPEOF(a)) {
710 
	case INTSXP:
 662 
	case INTSXP:
711 
	case FACTSXP:
 - 
 
712 
	case ORDSXP:
 - 
 
713 
	case LGLSXP:
 663 
	case LGLSXP:
714 
		for (i = 0; i < len; i++) {
 664 
		for (i = 0; i < len; i++) {
715 
			j = swap(i, dimsa, dimsr, perm, ind1, ind2);
 665 
			j = swap(i, dimsa, dimsr, perm, ind1, ind2);
716 
			INTEGER(r)[j] = INTEGER(a)[i];
 666 
			INTEGER(r)[j] = INTEGER(a)[i];
717 
		}
 667 
		}