SCM

SCM Repository

[matrix] Annotation of /branches/Matrix-mer2/src/ltCMatrix.c
ViewVC logotype

Annotation of /branches/Matrix-mer2/src/ltCMatrix.c

Parent Directory Parent Directory | Revision Log Revision Log


Revision 985 - (view) (download) (as text)

1 : bates 736 /* Sparse triangular logical matrices */
2 :     #include "ltCMatrix.h"
3 :    
4 : maechler 885 /**
5 : bates 736 * Check the validity of the slots of an ltCMatrix object
6 : maechler 885 *
7 : bates 736 * @param x Pointer to an ltCMatrix object
8 : maechler 885 *
9 : bates 736 * @return an SEXP that is either TRUE or a character string
10 :     * describing the way in which the object failed the validity check
11 :     */
12 :     SEXP ltCMatrix_validate(SEXP x)
13 :     {
14 : maechler 896 SEXP val = triangularMatrix_validate(x);
15 :     if(isString(val))
16 :     return(val);
17 :     else {
18 :     /* FIXME needed? ltC* inherits from lgC* which does this in validate*/
19 :     SEXP pslot = GET_SLOT(x, Matrix_pSym),
20 :     islot = GET_SLOT(x, Matrix_iSym);
21 :     int
22 :     ncol = length(pslot) - 1,
23 :     *xp = INTEGER(pslot),
24 :     *xi = INTEGER(islot);
25 : bates 736
26 : maechler 896 if (csc_unsorted_columns(ncol, xp, xi))
27 :     csc_sort_columns(ncol, xp, xi, (double *) NULL);
28 :     return ScalarLogical(1);
29 :     }
30 : bates 736 }
31 :    
32 : maechler 885 /**
33 : bates 736 * Transpose an ltCMatrix
34 : maechler 885 *
35 : bates 736 * @param x Pointer to an ltCMatrix object
36 : maechler 885 *
37 : bates 736 * @return the transpose of x. It represents the same matrix but is
38 :     * stored in the opposite triangle.
39 :     */
40 :     SEXP ltCMatrix_trans(SEXP x)
41 :     {
42 :     SEXP Xi = GET_SLOT(x, Matrix_iSym),
43 :     ans = PROTECT(NEW_OBJECT(MAKE_CLASS("ltCMatrix"))),
44 :     xdn = GET_SLOT(x, Matrix_DimNamesSym);
45 :     SEXP adn = ALLOC_SLOT(ans, Matrix_DimNamesSym, VECSXP, 2);
46 :     int *adims = INTEGER(ALLOC_SLOT(ans, Matrix_DimSym, INTSXP, 2)),
47 :     *xdims = INTEGER(GET_SLOT(x, Matrix_DimSym)),
48 : maechler 951 up = uplo_P(x)[0] == 'U';
49 : bates 736 int m = xdims[0], n = xdims[1], nz = length(Xi);
50 :     int *xj = expand_cmprPt(n, INTEGER(GET_SLOT(x, Matrix_pSym)),
51 :     Calloc(nz, int));
52 :    
53 :     adims[0] = n; adims[1] = m;
54 :     SET_VECTOR_ELT(adn, 0, VECTOR_ELT(xdn, 1));
55 :     SET_VECTOR_ELT(adn, 1, VECTOR_ELT(xdn, 0));
56 :     SET_SLOT(ans, Matrix_uploSym, mkString(up ? "L" : "U"));
57 :     SET_SLOT(ans, Matrix_diagSym, duplicate(GET_SLOT(x, Matrix_diagSym)));
58 :     triplet_to_col(n, m, nz, xj, INTEGER(Xi), (double *) NULL,
59 :     INTEGER(ALLOC_SLOT(ans, Matrix_pSym, INTSXP, m + 1)),
60 :     INTEGER(ALLOC_SLOT(ans, Matrix_iSym, INTSXP, nz)),
61 :     (double *) NULL);
62 :     Free(xj);
63 :     UNPROTECT(1);
64 :     return ans;
65 :     }
66 :    
67 : maechler 885 /**
68 : bates 736 * Solve one of the matrix equations op(A)*C = B, or
69 :     * C*op(A) = B where A is a square ltCMatrix and B and C are lgCMatrix
70 :     * objects.
71 : maechler 885 *
72 : bates 736 * @param side LFT or RGT
73 :     * @param transa TRN or NTR
74 :     * @param A pointer to an ltCMatrix object
75 :     * @param B pointer to an lgCMatrix object
76 :     * @param C pointer to an lgCMatrix object
77 :     */
78 :     void
79 :     ltClgCsm(enum CBLAS_SIDE side, enum CBLAS_TRANSPOSE transa,
80 :     SEXP A, SEXP B, SEXP C)
81 :     {
82 :     error(_("code not yet written"));
83 :     }

root@r-forge.r-project.org
ViewVC Help
Powered by ViewVC 1.0.0  
Thanks to:
Vienna University of Economics and Business Powered By FusionForge