The R Project SVN R-packages

Rev

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

Rev 4529 Rev 4543
Line 28... Line 28...
28 
	if (!strcmp(class, valid[ans])) return ans;
 28 
	if (!strcmp(class, valid[ans])) return ans;
29 
    }
 29 
    }
30 
}
 30 
}
31 
 
 31 
 
32 
/**
 32 
/**
33 
 * Create a cs object with the contents of x.  Note that
 33 
 * Create a cs object with the contents of x.
34 
 * the result should *not* be freed with cs_spfree.  Use
 - 
 
35 
 * Free on the result.
 - 
 
36 
 *
 34 
 *
37 
 * @param x pointer to an object that inherits from CsparseMatrix
 35 
 * @param x pointer to an object that inherits from CsparseMatrix
38 
 *
 36 
 *
39 
 * @return pointer to a cs object that contains pointers
 37 
 * @return pointer to a cs object that contains pointers
40 
 * to the slots of x.
 38 
 * to the slots of x.
41 
 */
 39 
 */
42 
cs *Matrix_as_cs(SEXP x)
 40 
cs *Matrix_as_cs(cs *ans, SEXP x)
43 
{
 41 
{
44 
    cs *ans = Calloc(1, cs);
 - 
 
45 
    char *valid[] = {"dgCMatrix", "dtCMatrix", ""};/* had also "dsCMatrix", but that
 42 
    char *valid[] = {"dgCMatrix", "dtCMatrix", ""};/* had also "dsCMatrix", but that
46 
						    * only stores one triangle */
 43 
						    * only stores one triangle */
47 
    int *dims, ctype = check_class(class_P(x), valid);
 44 
    int *dims, ctype = check_class(class_P(x), valid);
48 
    SEXP islot;
 45 
    SEXP islot;
49 
 
 46 
 
Line 59... Line 56...
59 
    ans->x = REAL(GET_SLOT(x, Matrix_xSym));
 56 
    ans->x = REAL(GET_SLOT(x, Matrix_xSym));
60 
 
 57 
 
61 
    return ans;
 58 
    return ans;
62 
}
 59 
}
63 
 
 60 
 
- 
 
 61 
/**
- 
 
 62 
 * Copy the contents of a to an appropriate CsparseMatrix object and,
- 
 
 63 
 * optionally, free a or free both a and the pointers to its contents.
- 
 
 64 
 *
- 
 
 65 
 * @param a matrix to be converted
- 
 
 66 
 * @param cl the name of the S4 class of the object to be generated
- 
 
 67 
 * @param dofree 0 - don't free a; > 0 cs_free a; < 0 Free a
- 
 
 68 
 *
- 
 
 69 
 * @return SEXP containing a copy of a
- 
 
 70 
 */
- 
 
 71 
SEXP Matrix_cs_to_SEXP(cs *a, char *cl, int dofree)
- 
 
 72 
{
- 
 
 73 
    SEXP ans;
- 
 
 74 
    char *valid[] = {"dgCMatrix", "dsCMatrix", "dtCMatrix", ""};
- 
 
 75 
    int *dims, ctype = check_class(cl, valid), nz;
- 
 
 76 
 
- 
 
 77 
    if (ctype < 0)
- 
 
 78 
	error("invalid class of object to Matrix_cs_to_SEXP");
- 
 
 79 
    ans = PROTECT(NEW_OBJECT(MAKE_CLASS(cl)));
- 
 
 80 
				/* allocate and copy common slots */
- 
 
 81 
    dims = INTEGER(ALLOC_SLOT(ans, Matrix_DimSym, INTSXP, 2));
- 
 
 82 
    dims[0] = a->m; dims[1] = a->n;
- 
 
 83 
    Memcpy(INTEGER(ALLOC_SLOT(ans, Matrix_pSym, INTSXP, a->n + 1)),
- 
 
 84 
	   a->p, a->n + 1);
- 
 
 85 
    nz = a->p[a->n];
- 
 
 86 
    Memcpy(INTEGER(ALLOC_SLOT(ans, Matrix_iSym, INTSXP, nz)), a->i, nz);
- 
 
 87 
    Memcpy(REAL(ALLOC_SLOT(ans, Matrix_xSym, REALSXP, nz)), a->x, nz);
- 
 
 88 
    if (ctype > 0) {
- 
 
 89 
	int uplo = is_sym(a);
- 
 
 90 
	if (!uplo) error("cs matrix not compatible with class");
- 
 
 91 
	SET_SLOT(ans, Matrix_diagSym, mkString("N"));
- 
 
 92 
	SET_SLOT(ans, Matrix_uploSym, mkString(uplo < 0 ? "L" : "U"));
- 
 
 93 
    }
- 
 
 94 
    if (dofree > 0) cs_spfree(a);
- 
 
 95 
    if (dofree < 0) Free(a);
- 
 
 96 
    UNPROTECT(1);
- 
 
 97 
    return ans;
- 
 
 98 
}
- 
 
 99 
 
64 
#if 0 				/* unused */
 100 
#if 0 				/* unused */
65 
/**
 101 
/**
66 
 * Create a css object with the contents of x.  Note that
 102 
 * Populate a css object with the contents of x.
67 
 * the result should *not* be freed with cs_sfree.  Use
 - 
 
68 
 * Free on the result but in the order
 - 
 
69 
 * Free(ans->L); Free(ans->U); Free(ans);
 - 
 
70 
 *
 103 
 *
- 
 
 104 
 * @param ans pointer to a csn object
71 
 * @param x pointer to an object of class css_LU or css_QR.
 105 
 * @param x pointer to an object of class css_LU or css_QR.
72 
 *
 106 
 *
73 
 * @return pointer to a cs object that contains pointers
 107 
 * @return pointer to a cs object that contains pointers
74 
 * to the slots of x.
 108 
 * to the slots of x.
75 
 */
 109 
 */
76 
css *Matrix_as_css(SEXP x)
 110 
css *Matrix_as_css(css *ans, SEXP x)
77 
{
 111 
{
78 
    css *ans = Calloc(1, css);
 - 
 
79 
    char *cl = class_P(x);
 112 
    char *cl = class_P(x);
80 
	*valid[] = {"css_LU", "css_QR", ""};
 113 
	*valid[] = {"css_LU", "css_QR", ""};
81 
    int *nz = INTEGER(GET_SLOT(x, install("nz"))),
 114 
    int *nz = INTEGER(GET_SLOT(x, install("nz"))),
82 
	ctype = check_class(cl, valid);
 115 
	ctype = check_class(cl, valid);
83 
 
 116 
 
Line 100... Line 133...
100 
    }
 133 
    }
101 
    return ans;
 134 
    return ans;
102 
}
 135 
}
103 
 
 136 
 
104 
/**
 137 
/**
105 
 * Create a csn object with the contents of x.  Note that
 138 
 * Populate a csn object with the contents of x.
106 
 * the result should *not* be freed with cs_sfree.  Use
 - 
 
107 
 * Free on the result but in the order
 - 
 
108 
 * Free(ans->L); Free(ans->U); Free(ans);
 - 
 
109 
 *
 139 
 *
- 
 
 140 
 * @param ans pointer to a csn object
110 
 * @param x pointer to an object of class csn_LU or csn_QR.
 141 
 * @param x pointer to an object of class csn_LU or csn_QR.
111 
 *
 142 
 *
112 
 * @return pointer to a cs object that contains pointers
 143 
 * @return pointer to a cs object that contains pointers
113 
 * to the slots of x.
 144 
 * to the slots of x.
114 
 */
 145 
 */
115 
csn *Matrix_as_csn(SEXP x)
 146 
csn *Matrix_as_csn(csn *ans, SEXP x)
116 
{
 147 
{
117 
    csn *ans = Calloc(1, csn);
 - 
 
118 
    char *valid[] = {"csn_LU", "csn_QR", ""};
 148 
    char *valid[] = {"csn_LU", "csn_QR", ""};
119 
    int ctype = check_class(class_P(x), valid);
 149 
    int ctype = check_class(class_P(x), valid);
120 
 
 150 
 
121 
    if (ctype < 0) error("invalid class of object to Matrix_as_csn");
 151 
    if (ctype < 0) error("invalid class of object to Matrix_as_csn");
122 
    ans->U = Matrix_as_cs(GET_SLOT(x, install("U")));
 152 
    ans->U = Matrix_as_cs(GET_SLOT(x, install("U")));
Line 133... Line 163...
133 
    default:
 163 
    default:
134 
	error("invalid class of object to Matrix_as_csn");
 164 
	error("invalid class of object to Matrix_as_csn");
135 
    }
 165 
    }
136 
    return ans;
 166 
    return ans;
137 
}
 167 
}
138 
#endif	/* unused */
 - 
 
139 
 
 168 
 
140 
/**
 169 
/**
141 
 * Copy the contents of a to an appropriate CsparseMatrix object and,
 - 
 
142 
 * optionally, free a or free both a and the pointers to its contents.
 - 
 
143 
 *
 - 
 
144 
 * @param a matrix to be converted
 - 
 
145 
 * @param cl the name of the S4 class of the object to be generated
 - 
 
146 
 * @param dofree 0 - don't free a; > 0 cs_free a; < 0 Free a
 - 
 
147 
 *
 - 
 
148 
 * @return SEXP containing a copy of a
 - 
 
149 
 */
 - 
 
150 
SEXP Matrix_cs_to_SEXP(cs *a, char *cl, int dofree)
 - 
 
151 
{
 - 
 
152 
    SEXP ans;
 - 
 
153 
    char *valid[] = {"dgCMatrix", "dsCMatrix", "dtCMatrix", ""};
 - 
 
154 
    int *dims, ctype = check_class(cl, valid), nz;
 - 
 
155 
 
 - 
 
156 
    if (ctype < 0)
 - 
 
157 
	error("invalid class of object to Matrix_cs_to_SEXP");
 - 
 
158 
    ans = PROTECT(NEW_OBJECT(MAKE_CLASS(cl)));
 - 
 
159 
				/* allocate and copy common slots */
 - 
 
160 
    dims = INTEGER(ALLOC_SLOT(ans, Matrix_DimSym, INTSXP, 2));
 - 
 
161 
    dims[0] = a->m; dims[1] = a->n;
 - 
 
162 
    Memcpy(INTEGER(ALLOC_SLOT(ans, Matrix_pSym, INTSXP, a->n + 1)),
 - 
 
163 
	   a->p, a->n + 1);
 - 
 
164 
    nz = a->p[a->n];
 - 
 
165 
    Memcpy(INTEGER(ALLOC_SLOT(ans, Matrix_iSym, INTSXP, nz)), a->i, nz);
 - 
 
166 
    Memcpy(REAL(ALLOC_SLOT(ans, Matrix_xSym, REALSXP, nz)), a->x, nz);
 - 
 
167 
    if (ctype > 0) {
 - 
 
168 
	int uplo = is_sym(a);
 - 
 
169 
	if (!uplo) error("cs matrix not compatible with class");
 - 
 
170 
	SET_SLOT(ans, Matrix_diagSym, mkString("N"));
 - 
 
171 
	SET_SLOT(ans, Matrix_uploSym, mkString(uplo < 0 ? "L" : "U"));
 - 
 
172 
    }
 - 
 
173 
    if (dofree > 0) cs_spfree(a);
 - 
 
174 
    if (dofree < 0) Free(a);
 - 
 
175 
    UNPROTECT(1);
 - 
 
176 
    return ans;
 - 
 
177 
}
 - 
 
178 
 
 - 
 
179 
#if 0 				/* unused */
 - 
 
180 
/**
 - 
 
181 
 * Copy the contents of S to a css_LU or css_QR object and,
 170 
 * Copy the contents of S to a css_LU or css_QR object and,
182 
 * optionally, free S or free both S and the pointers to its contents.
 171 
 * optionally, free S or free both S and the pointers to its contents.
183 
 *
 172 
 *
184 
 * @param a css object to be converted
 173 
 * @param a css object to be converted
185 
 * @param cl the name of the S4 class of the object to be generated
 174 
 * @param cl the name of the S4 class of the object to be generated