The R Project SVN R-packages

Rev

Rev 4901 | Show entire file | Ignore whitespace | Details | Blame | Last modification | View Log | RSS feed

Rev 4901 Rev 4963
Line 18... Line 18...
18 
    }
 18 
    }
19 
    return (is_upper ? 1 : (is_lower ? -1 : 0)) ;
 19 
    return (is_upper ? 1 : (is_lower ? -1 : 0)) ;
20 
}
 20 
}
21 
 
 21 
 
22 
/**
 22 
/**
23 
 * Create a cs object with the contents of x.
 23 
 * Create a cs object with the contents of x.  Typically called via  AS_CSP()
24 
 *
 24 
 *
25 
 * @param ans pointer to a cs struct.  This is allocated in the caller
 25 
 * @param ans pointer to a cs struct.  This is allocated in the caller
26 
 * so it is easier to keep track of where it should be freed - in many
 26 
 * so it is easier to keep track of where it should be freed - in many
27 
 * applications the memory can be allocated with alloca and
 27 
 * applications the memory can be allocated with alloca and
28 
 * automatically freed on exit from the caller.
 28 
 * automatically freed on exit from the caller.
Line 67... Line 67...
67 
    SEXP ans;
 67 
    SEXP ans;
68 
    char *valid[] = {"dgCMatrix", "dsCMatrix", "dtCMatrix", ""};
 68 
    char *valid[] = {"dgCMatrix", "dsCMatrix", "dtCMatrix", ""};
69 
    int *dims, ctype = Matrix_check_class(cl, valid), nz;
 69 
    int *dims, ctype = Matrix_check_class(cl, valid), nz;
70 
 
 70 
 
71 
    if (ctype < 0)
 71 
    if (ctype < 0)
72 
	error("invalid class of object to Matrix_cs_to_SEXP");
 72 
	error(_("invalid class of object to Matrix_cs_to_SEXP"));
73 
    ans = PROTECT(NEW_OBJECT(MAKE_CLASS(cl)));
 73 
    ans = PROTECT(NEW_OBJECT(MAKE_CLASS(cl)));
74 
				/* allocate and copy common slots */
 74 
				/* allocate and copy common slots */
75 
    dims = INTEGER(ALLOC_SLOT(ans, Matrix_DimSym, INTSXP, 2));
 75 
    dims = INTEGER(ALLOC_SLOT(ans, Matrix_DimSym, INTSXP, 2));
76 
    dims[0] = a->m; dims[1] = a->n;
 76 
    dims[0] = a->m; dims[1] = a->n;
77 
    Memcpy(INTEGER(ALLOC_SLOT(ans, Matrix_pSym, INTSXP, a->n + 1)),
 77 
    Memcpy(INTEGER(ALLOC_SLOT(ans, Matrix_pSym, INTSXP, a->n + 1)),
78 
	   a->p, a->n + 1);
 78 
	   a->p, a->n + 1);
79 
    nz = a->p[a->n];
 79 
    nz = a->p[a->n];
80 
    Memcpy(INTEGER(ALLOC_SLOT(ans, Matrix_iSym, INTSXP, nz)), a->i, nz);
 80 
    Memcpy(INTEGER(ALLOC_SLOT(ans, Matrix_iSym, INTSXP, nz)), a->i, nz);
81 
    Memcpy(REAL(ALLOC_SLOT(ans, Matrix_xSym, REALSXP, nz)), a->x, nz);
 81 
    Memcpy(REAL(ALLOC_SLOT(ans, Matrix_xSym, REALSXP, nz)), a->x, nz);
82 
    if (ctype > 0) {
 82 
    if (ctype > 0) { /* dsC or dtC */
83 
	int uplo = is_sym(a);
 83 
	int uplo = is_sym(a);
- 
 
 84 
	if (!uplo)
84 
	if (!uplo) error("cs matrix not compatible with class");
 85 
	    error(_("cs matrix not compatible with class '%s'"), valid[ctype]);
- 
 
 86 
	if (ctype == 2) /* dtC* */
85 
	SET_SLOT(ans, Matrix_diagSym, mkString("N"));
 87 
	    SET_SLOT(ans, Matrix_diagSym, mkString("N"));
86 
	SET_SLOT(ans, Matrix_uploSym, mkString(uplo < 0 ? "L" : "U"));
 88 
	SET_SLOT(ans, Matrix_uploSym, mkString(uplo < 0 ? "L" : "U"));
87 
    }
 89 
    }
88 
    if (dofree > 0) cs_spfree(a);
 90 
    if (dofree > 0) cs_spfree(a);
89 
    if (dofree < 0) Free(a);
 91 
    if (dofree < 0) Free(a);
90 
    UNPROTECT(1);
 92 
    UNPROTECT(1);
91 
    return ans;
 93 
    return ans;
92 
}
 94 
}
93 
 
 95 
 
94 
#if 0 				/* unused */
 96 
#if 0 				/* unused ------------------------------------*/
95 
/**
 97 
/**
96 
 * Populate a css object with the contents of x.
 98 
 * Populate a css object with the contents of x.
97 
 *
 99 
 *
98 
 * @param ans pointer to a csn object
 100 
 * @param ans pointer to a csn object
99 
 * @param x pointer to an object of class css_LU or css_QR.
 101 
 * @param x pointer to an object of class css_LU or css_QR.