The R Project SVN R

Rev

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

Rev 1858 Rev 1881
Line 25... Line 25...
25 
/* locate and return the row names and column names from the */
 25 
/* locate and return the row names and column names from the */
26 
/* dimnames attribute of a matrix.  They are useful because */
 26 
/* dimnames attribute of a matrix.  They are useful because */
27 
/* old versions of R used pair-based lists for dimnames */
 27 
/* old versions of R used pair-based lists for dimnames */
28 
/* whereas recent versions use vector bassed lists */
 28 
/* whereas recent versions use vector bassed lists */
29 
 
 29 
 
- 
 
 30 
/* FIXME : This is nonsense.  When the "dimnames" attribute is */
- 
 
 31 
/* grabbed off an array it is always adjusted to be a vector. */
- 
 
 32 
 
30 
SEXP GetRowNames(SEXP dimnames)
 33 
SEXP GetRowNames(SEXP dimnames)
31 
{
 34 
{
32 
    if (TYPEOF(dimnames) == VECSXP)
 35 
    if (TYPEOF(dimnames) == VECSXP)
33 
	return VECTOR(dimnames)[0];
 36 
	return VECTOR(dimnames)[0];
34 
    else if (TYPEOF(dimnames) == LISTSXP)
 37 
    else if (TYPEOF(dimnames) == LISTSXP)
Line 59... Line 62...
59 
    byrow = asInteger(CADR(CDDR(args)));
 62 
    byrow = asInteger(CADR(CDDR(args)));
60 
 
 63 
 
61 
    if (isVector(vals) || isList(vals)) {
 64 
    if (isVector(vals) || isList(vals)) {
62 
	if (length(vals) < 0)
 65 
	if (length(vals) < 0)
63 
	    errorcall(call, "argument has length zero\n");
 66 
	    errorcall(call, "argument has length zero\n");
- 
 
 67 
    }
64 
    } else errorcall(call, "invalid matrix element type\n");
 68 
    else errorcall(call, "invalid matrix element type\n");
65 
 
 69 
 
66 
    if (!isNumeric(snr) || !isNumeric(snc))
 70 
    if (!isNumeric(snr) || !isNumeric(snc))
67 
	error("non-numeric matrix extent\n");
 71 
	error("non-numeric matrix extent\n");
68 
 
 72 
 
69 
    lendat = length(vals);
 73 
    lendat = length(vals);
Line 526... Line 530...
526 
	    matprod(REAL(CAR(args)), nrx, ncx,
 530 
	    matprod(REAL(CAR(args)), nrx, ncx,
527 
		    REAL(CADR(args)), nry, ncy, REAL(ans));
 531 
		    REAL(CADR(args)), nry, ncy, REAL(ans));
528 
	PROTECT(xdims = getAttrib(CAR(args), R_DimNamesSymbol));
 532 
	PROTECT(xdims = getAttrib(CAR(args), R_DimNamesSymbol));
529 
	PROTECT(ydims = getAttrib(CADR(args), R_DimNamesSymbol));
 533 
	PROTECT(ydims = getAttrib(CADR(args), R_DimNamesSymbol));
530 
	if (xdims != R_NilValue || ydims != R_NilValue) {
 534 
	if (xdims != R_NilValue || ydims != R_NilValue) {
531 
#ifdef NEWLIST
 - 
 
532 
	    SEXP dimnames = allocVector(VECSXP, 2);
 535 
	    SEXP dimnames = allocVector(VECSXP, 2);
533 
	    if (xdims != R_NilValue)
 536 
	    if (xdims != R_NilValue)
534 
		VECTOR(dimnames)[0] = VECTOR(xdims)[0];
 537 
		VECTOR(dimnames)[0] = VECTOR(xdims)[0];
535 
	    if (ydims != R_NilValue)
 538 
	    if (ydims != R_NilValue)
536 
		VECTOR(dimnames)[1] = VECTOR(ydims)[1];
 539 
		VECTOR(dimnames)[1] = VECTOR(ydims)[1];
537 
	    setAttrib(ans, R_DimNamesSymbol, dimnames);
 540 
	    setAttrib(ans, R_DimNamesSymbol, dimnames);
538 
#else
 - 
 
539 
	    setAttrib(ans, R_DimNamesSymbol, list2(CAR(xdims), CADR(ydims)));
 - 
 
540 
#endif
 - 
 
541 
	}
 541 
	}
542 
    }
 542 
    }
543 
    else {
 543 
    else {
544 
	PROTECT(ans = allocMatrix(mode, ncx, ncy));
 544 
	PROTECT(ans = allocMatrix(mode, ncx, ncy));
545 
	if (mode == CPLXSXP)
 545 
	if (mode == CPLXSXP)
Line 549... Line 549...
549 
	    crossprod(REAL(CAR(args)), nrx, ncx,
 549 
	    crossprod(REAL(CAR(args)), nrx, ncx,
550 
		      REAL(CADR(args)), nry, ncy, REAL(ans));
 550 
		      REAL(CADR(args)), nry, ncy, REAL(ans));
551 
	PROTECT(xdims = getAttrib(CAR(args), R_DimNamesSymbol));
 551 
	PROTECT(xdims = getAttrib(CAR(args), R_DimNamesSymbol));
552 
	PROTECT(ydims = getAttrib(CADR(args), R_DimNamesSymbol));
 552 
	PROTECT(ydims = getAttrib(CADR(args), R_DimNamesSymbol));
553 
	if (xdims != R_NilValue || ydims != R_NilValue) {
 553 
	if (xdims != R_NilValue || ydims != R_NilValue) {
554 
#ifdef NEWLIST
 - 
 
555 
	    SEXP dimnames = allocVector(VECSXP, 2);
 554 
	    SEXP dimnames = allocVector(VECSXP, 2);
556 
	    if (xdims != R_NilValue)
 555 
	    if (xdims != R_NilValue)
557 
		VECTOR(dimnames)[0] = VECTOR(xdims)[1];
 556 
		VECTOR(dimnames)[0] = VECTOR(xdims)[1];
558 
	    if (ydims != R_NilValue)
 557 
	    if (ydims != R_NilValue)
559 
		VECTOR(dimnames)[1] = VECTOR(ydims)[1];
 558 
		VECTOR(dimnames)[1] = VECTOR(ydims)[1];
560 
	    setAttrib(ans, R_DimNamesSymbol, dimnames);
 559 
	    setAttrib(ans, R_DimNamesSymbol, dimnames);
561 
#else
 - 
 
562 
	    setAttrib(ans, R_DimNamesSymbol, list2(CADR(xdims), CADR(ydims)));
 - 
 
563 
#endif
 - 
 
564 
	}
 560 
	}
565 
    }
 561 
    }
566 
    UNPROTECT(3);
 562 
    UNPROTECT(3);
567 
    return ans;
 563 
    return ans;
568 
}
 564 
}