Matrix  $Rev: 3071 $ at $LastChangedDate: 2015-03-26 15:35:47 +0100 (Thu, 26 Mar 2015) $
ldense.c
Go to the documentation of this file.
1 #include "ldense.h"
2 
3 /* dense logical Matrices "ldenseMatrix" classes --- almost identical to
4  * dense nonzero-pattern: "ndenseMatrix" ones
5  */
6 
7 /* this is very close to dspMatrix_as_dsy* () in ./dspMatrix.c : */
8 SEXP lspMatrix_as_lsyMatrix(SEXP from, SEXP kind)
9 {
10  SEXP val = PROTECT(NEW_OBJECT(MAKE_CLASS((asInteger(kind) == 1) ?
11  "nsyMatrix" :
12  "lsyMatrix"))),
13  uplo = GET_SLOT(from, Matrix_uploSym),
14  dimP = GET_SLOT(from, Matrix_DimSym),
15  dmnP = GET_SLOT(from, Matrix_DimNamesSym);
16  int n = *INTEGER(dimP);
17 
18  SET_SLOT(val, Matrix_DimSym, duplicate(dimP));
19  SET_SLOT(val, Matrix_DimNamesSym, duplicate(dmnP));
20  SET_SLOT(val, Matrix_uploSym, duplicate(uplo));
21  packed_to_full_int(LOGICAL(ALLOC_SLOT(val, Matrix_xSym, LGLSXP, n*n)),
22  LOGICAL( GET_SLOT(from, Matrix_xSym)), n,
23  *CHAR(STRING_ELT(uplo, 0)) == 'U' ? UPP : LOW);
24  UNPROTECT(1);
25  return val;
26 }
27 
28 // this is very close to dsyMatrix_as_lsp*() in ./dsyMatrix.c -- keep synced !
29 SEXP lsyMatrix_as_lspMatrix(SEXP from, SEXP kind)
30 {
31  SEXP val = PROTECT(NEW_OBJECT(MAKE_CLASS((asInteger(kind) == 1) ?
32  "nspMatrix" :
33  "lspMatrix"))),
34  uplo = GET_SLOT(from, Matrix_uploSym),
35  dimP = GET_SLOT(from, Matrix_DimSym);
36  int n = *INTEGER(dimP);
37 
38  SET_SLOT(val, Matrix_DimSym, duplicate(dimP));
39  SET_SLOT(val, Matrix_uploSym, duplicate(uplo));
40  full_to_packed_int(
41  LOGICAL(ALLOC_SLOT(val, Matrix_xSym, LGLSXP, (n*(n+1))/2)),
42  LOGICAL( GET_SLOT(from, Matrix_xSym)), n,
43  *CHAR(STRING_ELT(uplo, 0)) == 'U' ? UPP : LOW, NUN);
44  SET_SLOT(val, Matrix_DimNamesSym,
45  duplicate(GET_SLOT(from, Matrix_DimNamesSym)));
46  SET_SLOT(val, Matrix_factorSym,
47  duplicate(GET_SLOT(from, Matrix_factorSym)));
48  UNPROTECT(1);
49  return val;
50 }
51 
52 // this is very close to dtpMatrix_as_dtr*() in ./dtpMatrix.c -- keep synced!
53 SEXP ltpMatrix_as_ltrMatrix(SEXP from, SEXP kind)
54 {
55  SEXP val = PROTECT(NEW_OBJECT(MAKE_CLASS((asInteger(kind) == 1) ?
56  "ntrMatrix" :
57  "ltrMatrix"))),
58  uplo = GET_SLOT(from, Matrix_uploSym),
59  diag = GET_SLOT(from, Matrix_diagSym),
60  dimP = GET_SLOT(from, Matrix_DimSym),
61  dmnP = GET_SLOT(from, Matrix_DimNamesSym);
62  int n = *INTEGER(dimP);
63 
64  SET_SLOT(val, Matrix_DimSym, duplicate(dimP));
65  SET_SLOT(val, Matrix_DimNamesSym, duplicate(dmnP));
66  SET_SLOT(val, Matrix_diagSym, duplicate(diag));
67  SET_SLOT(val, Matrix_uploSym, duplicate(uplo));
68  packed_to_full_int(LOGICAL(ALLOC_SLOT(val, Matrix_xSym, LGLSXP, n*n)),
69  LOGICAL(GET_SLOT(from, Matrix_xSym)), n,
70  *CHAR(STRING_ELT(uplo, 0)) == 'U' ? UPP : LOW);
71  SET_SLOT(val, Matrix_DimNamesSym,
72  duplicate(GET_SLOT(from, Matrix_DimNamesSym)));
73  UNPROTECT(1);
74  return val;
75 }
76 
77 /* this is very close to dtrMatrix_as_dtp* () in ./dtrMatrix.c : */
78 SEXP ltrMatrix_as_ltpMatrix(SEXP from, SEXP kind)
79 {
80  SEXP val = PROTECT(NEW_OBJECT(MAKE_CLASS((asInteger(kind) == 1) ?
81  "ntpMatrix" :
82  "ltpMatrix"))),
83  uplo = GET_SLOT(from, Matrix_uploSym),
84  diag = GET_SLOT(from, Matrix_diagSym),
85  dimP = GET_SLOT(from, Matrix_DimSym);
86  int n = *INTEGER(dimP);
87 
88  SET_SLOT(val, Matrix_DimSym, duplicate(dimP));
89  SET_SLOT(val, Matrix_diagSym, duplicate(diag));
90  SET_SLOT(val, Matrix_uploSym, duplicate(uplo));
91  full_to_packed_int(
92  LOGICAL(ALLOC_SLOT(val, Matrix_xSym, LGLSXP, (n*(n+1))/2)),
93  LOGICAL(GET_SLOT(from, Matrix_xSym)), n,
94  *CHAR(STRING_ELT(uplo, 0)) == 'U' ? UPP : LOW,
95  *CHAR(STRING_ELT(diag, 0)) == 'U' ? UNT : NUN);
96  SET_SLOT(val, Matrix_DimNamesSym,
97  duplicate(GET_SLOT(from, Matrix_DimNamesSym)));
98  UNPROTECT(1);
99  return val;
100 }
101 
102 /* this is very close to dtrMatrix_as_dge*() :*/
103 SEXP ltrMatrix_as_lgeMatrix(SEXP from, SEXP kind)
104 {
105  SEXP val = PROTECT(NEW_OBJECT(MAKE_CLASS((asInteger(kind) == 1) ?
106  "ngeMatrix" :
107  "lgeMatrix")));
108 
109  slot_dup(val, from, Matrix_xSym);
110  slot_dup(val, from, Matrix_DimSym);
111  slot_dup(val, from, Matrix_DimNamesSym);
112  SET_SLOT(val, Matrix_factorSym, allocVector(VECSXP, 0));
113 
114  make_i_matrix_triangular(LOGICAL(GET_SLOT(val, Matrix_xSym)), from);
115  UNPROTECT(1);
116  return val;
117 }
118 
119 /* this is very close to dsyMatrix_as_dge*() :*/
120 SEXP lsyMatrix_as_lgeMatrix(SEXP from, SEXP kind)
121 {
122  SEXP val = PROTECT(NEW_OBJECT(MAKE_CLASS((asInteger(kind) == 1) ?
123  "ngeMatrix" :
124  "lgeMatrix")));
125 
126  slot_dup(val, from, Matrix_xSym);
127  slot_dup(val, from, Matrix_DimSym);
128  slot_dup(val, from, Matrix_DimNamesSym);
129  SET_SLOT(val, Matrix_factorSym, allocVector(VECSXP, 0));
130 
131  make_i_matrix_symmetric(LOGICAL(GET_SLOT(val, Matrix_xSym)), from);
132  UNPROTECT(1);
133  return val;
134 }
135 
SEXP Matrix_DimSym
Definition: Syms.h:2
SEXP lsyMatrix_as_lgeMatrix(SEXP from, SEXP kind)
Definition: ldense.c:120
SEXP Matrix_xSym
Definition: Syms.h:2
#define slot_dup(dest, src, sym)
Definition: Mutils.h:149
SEXP Matrix_factorSym
Definition: Syms.h:2
SEXP Matrix_DimNamesSym
Definition: Syms.h:2
void make_i_matrix_symmetric(int *to, SEXP from)
SEXP Matrix_uploSym
Definition: Syms.h:2
void make_i_matrix_triangular(int *x, SEXP from)
SEXP lsyMatrix_as_lspMatrix(SEXP from, SEXP kind)
Definition: ldense.c:29
SEXP ltrMatrix_as_lgeMatrix(SEXP from, SEXP kind)
Definition: ldense.c:103
#define UPP
Definition: Mutils.h:81
SEXP ltpMatrix_as_ltrMatrix(SEXP from, SEXP kind)
Definition: ldense.c:53
SEXP lspMatrix_as_lsyMatrix(SEXP from, SEXP kind)
Definition: ldense.c:8
SEXP ltrMatrix_as_ltpMatrix(SEXP from, SEXP kind)
Definition: ldense.c:78
#define LOW
Definition: Mutils.h:82
#define UNT
Definition: Mutils.h:84
SEXP Matrix_diagSym
Definition: Syms.h:2
#define NUN
Definition: Mutils.h:83
static R_INLINE SEXP ALLOC_SLOT(SEXP obj, SEXP nm, SEXPTYPE type, int length)
Allocate an SEXP of given type and length, assign it as slot nm in the object, and return the SEXP...
Definition: Mutils.h:240