SCM

SCM Repository

[matrix] Annotation of /pkg/src/ldense.c
ViewVC logotype

Annotation of /pkg/src/ldense.c

Parent Directory Parent Directory | Revision Log Revision Log


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

1 : maechler 945 #include "ldense.h"
2 :    
3 :     /* this is very close to dspMatrix_as_dsy* () in ./dspMatrix.c : */
4 :     SEXP lspMatrix_as_lsyMatrix(SEXP from)
5 :     {
6 :     SEXP val = PROTECT(NEW_OBJECT(MAKE_CLASS("lsyMatrix"))),
7 :     uplo = GET_SLOT(from, Matrix_uploSym),
8 :     dimP = GET_SLOT(from, Matrix_DimSym),
9 :     dmnP = GET_SLOT(from, Matrix_DimNamesSym);
10 :     int n = *INTEGER(dimP);
11 :    
12 :     SET_SLOT(val, Matrix_DimSym, duplicate(dimP));
13 :     SET_SLOT(val, Matrix_DimNamesSym, duplicate(dmnP));
14 :     SET_SLOT(val, Matrix_uploSym, duplicate(uplo));
15 : maechler 952 packed_to_full_int(LOGICAL(ALLOC_SLOT(val, Matrix_xSym, LGLSXP, n*n)),
16 :     LOGICAL( GET_SLOT(from, Matrix_xSym)), n,
17 :     *CHAR(STRING_ELT(uplo, 0)) == 'U' ? UPP : LOW);
18 : maechler 945 UNPROTECT(1);
19 :     return val;
20 :     }
21 :    
22 :     /* this is very close to dsyMatrix_as_dsp* () in ./dsyMatrix.c : */
23 :     SEXP lsyMatrix_as_lspMatrix(SEXP from)
24 :     {
25 :     SEXP val = PROTECT(NEW_OBJECT(MAKE_CLASS("lspMatrix"))),
26 :     uplo = GET_SLOT(from, Matrix_uploSym),
27 :     dimP = GET_SLOT(from, Matrix_DimSym);
28 :     int n = *INTEGER(dimP);
29 :    
30 :     SET_SLOT(val, Matrix_DimSym, duplicate(dimP));
31 :     SET_SLOT(val, Matrix_uploSym, duplicate(uplo));
32 : maechler 952 full_to_packed_int(
33 :     LOGICAL(ALLOC_SLOT(val, Matrix_xSym, LGLSXP, (n*(n+1))/2)),
34 :     LOGICAL( GET_SLOT(from, Matrix_xSym)), n,
35 :     *CHAR(STRING_ELT(uplo, 0)) == 'U' ? UPP : LOW, NUN);
36 : maechler 945 UNPROTECT(1);
37 :     return val;
38 :     }
39 :    
40 :     /* this is very close to dtpMatrix_as_dtr* () in ./dtpMatrix.c : */
41 :     SEXP ltpMatrix_as_ltrMatrix(SEXP from)
42 :     {
43 :     SEXP val = PROTECT(NEW_OBJECT(MAKE_CLASS("ltrMatrix"))),
44 :     uplo = GET_SLOT(from, Matrix_uploSym),
45 :     diag = GET_SLOT(from, Matrix_diagSym),
46 :     dimP = GET_SLOT(from, Matrix_DimSym),
47 :     dmnP = GET_SLOT(from, Matrix_DimNamesSym);
48 :     int n = *INTEGER(dimP);
49 :    
50 :     SET_SLOT(val, Matrix_DimSym, duplicate(dimP));
51 :     SET_SLOT(val, Matrix_DimNamesSym, duplicate(dmnP));
52 :     SET_SLOT(val, Matrix_diagSym, duplicate(diag));
53 :     SET_SLOT(val, Matrix_uploSym, duplicate(uplo));
54 : maechler 952 packed_to_full_int(LOGICAL(ALLOC_SLOT(val, Matrix_xSym, LGLSXP, n*n)),
55 :     LOGICAL(GET_SLOT(from, Matrix_xSym)), n,
56 :     *CHAR(STRING_ELT(uplo, 0)) == 'U' ? UPP : LOW);
57 : maechler 945 UNPROTECT(1);
58 :     return val;
59 :     }
60 :    
61 :     /* this is very close to dtrMatrix_as_dtp* () in ./dtrMatrix.c : */
62 :     SEXP ltrMatrix_as_ltpMatrix(SEXP from)
63 :     {
64 :     SEXP val = PROTECT(NEW_OBJECT(MAKE_CLASS("ltpMatrix"))),
65 :     uplo = GET_SLOT(from, Matrix_uploSym),
66 :     diag = GET_SLOT(from, Matrix_diagSym),
67 :     dimP = GET_SLOT(from, Matrix_DimSym);
68 :     int n = *INTEGER(dimP);
69 :    
70 :     SET_SLOT(val, Matrix_DimSym, duplicate(dimP));
71 :     SET_SLOT(val, Matrix_diagSym, duplicate(diag));
72 :     SET_SLOT(val, Matrix_uploSym, duplicate(uplo));
73 : maechler 952 full_to_packed_int(
74 :     LOGICAL(ALLOC_SLOT(val, Matrix_xSym, LGLSXP, (n*(n+1))/2)),
75 :     LOGICAL(GET_SLOT(from, Matrix_xSym)), n,
76 :     *CHAR(STRING_ELT(uplo, 0)) == 'U' ? UPP : LOW,
77 :     *CHAR(STRING_ELT(diag, 0)) == 'U' ? UNT : NUN);
78 : maechler 945 UNPROTECT(1);
79 :     return val;
80 :     }

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