The R Project SVN R

Rev

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

Rev 61696 Rev 62618
Line 1582... Line 1582...
1582 
	error(_("invalid '%s' argument"), "k");
 1582 
	error(_("invalid '%s' argument"), "k");
1583 
    int upper = asLogical(CAR(args)); args = CDR(args);
 1583 
    int upper = asLogical(CAR(args)); args = CDR(args);
1584 
    if (upper == NA_INTEGER) error(_("invalid '%s' argument"), "upper.tri");
 1584 
    if (upper == NA_INTEGER) error(_("invalid '%s' argument"), "upper.tri");
1585 
    int trans = asLogical(CAR(args));
 1585 
    int trans = asLogical(CAR(args));
1586 
    if (trans == NA_INTEGER) error(_("invalid '%s' argument"), "transpose");
 1586 
    if (trans == NA_INTEGER) error(_("invalid '%s' argument"), "transpose");
1587 
    SEXP ans;
 - 
 
1588 
    if (TYPEOF(r) != REALSXP) {PROTECT(r = coerceVector(r, REALSXP)); nprot++;}
 1587 
    if (TYPEOF(r) != REALSXP) {PROTECT(r = coerceVector(r, REALSXP)); nprot++;}
1589 
    if (TYPEOF(b) != REALSXP) {PROTECT(b = coerceVector(b, REALSXP)); nprot++;}
 1588 
    if (TYPEOF(b) != REALSXP) {PROTECT(b = coerceVector(b, REALSXP)); nprot++;}
1590 
    double *rr = REAL(r);
 1589 
    double *rr = REAL(r);
1591 
 
 1590 
 
1592 
    /* check for zeros on diagonal of r: only k row/cols are used. */
 1591 
    /* check for zeros on diagonal of r: only k row/cols are used. */
Line 1595... Line 1594...
1595 
	if (rr[i * incr] == 0.0)
 1594 
	if (rr[i * incr] == 0.0)
1596 
	    error(_("singular matrix in 'backsolve'. First zero in diagonal [%d]"),
 1595 
	    error(_("singular matrix in 'backsolve'. First zero in diagonal [%d]"),
1597 
		  i + 1);
 1596 
		  i + 1);
1598 
    }
 1597 
    }
1599 
 
 1598 
 
1600 
    PROTECT(ans = allocMatrix(REALSXP, k, ncb));
 1599 
    SEXP ans = PROTECT(allocMatrix(REALSXP, k, ncb));
1601 
    if (k > 0 && ncb > 0) {
 1600 
    if (k > 0 && ncb > 0) {
1602 
       /* copy (part) cols of b to ans */
 1601 
       /* copy (part) cols of b to ans */
1603 
	for(R_xlen_t j = 0; j < ncb; j++)
 1602 
	for(R_xlen_t j = 0; j < ncb; j++)
1604 
	    memcpy(REAL(ans) + j*k, REAL(b) + j*nrb, (size_t)k *sizeof(double));
 1603 
	    memcpy(REAL(ans) + j*k, REAL(b) + j*nrb, (size_t)k *sizeof(double));
1605 
	double one = 1.0;
 1604 
	double one = 1.0;
Line 1615... Line 1614...
1615 
{
 1614 
{
1616 
    checkArity(op, args);
 1615 
    checkArity(op, args);
1617 
    SEXP m = CAR(args);
 1616 
    SEXP m = CAR(args);
1618 
    int method = asInteger(CADR(args));
 1617 
    int method = asInteger(CADR(args));
1619 
    int nr = nrows(m), nc = ncols(m), nprot = 1;
 1618 
    int nr = nrows(m), nc = ncols(m), nprot = 1;
1620 
    if (TYPEOF(m) != REALSXP) PROTECT(m = coerceVector(m, REALSXP));
 1619 
    if (TYPEOF(m) != REALSXP) {PROTECT(m = coerceVector(m, REALSXP)); nprot++;}
1621 
    SEXP ans = allocVector(INTSXP, nr);
 1620 
    SEXP ans = PROTECT(allocVector(INTSXP, nr));
1622 
    PROTECT(ans);
 - 
 
1623 
    R_max_col(REAL(m), &nr, &nc, INTEGER(ans), &method);
 1621 
    R_max_col(REAL(m), &nr, &nc, INTEGER(ans), &method);
1624 
    UNPROTECT(nprot);
 1622 
    UNPROTECT(nprot);
1625 
    return ans;
 1623 
    return ans;
1626 
}
 1624 
}