Matrix r5059
Loading...
Searching...
No Matches
t.c
Go to the documentation of this file.
1/* C implementation of methods for t, ct */
2
3#include "Mdefines.h"
4#include "M5.h"
5#include "idz.h"
6
7SEXP dense_transpose(SEXP from, const char *class, char op_ct)
8{
9 int packed = class[2] == 'p';
10 char ul = '\0';
11
12 if (class[0] != 'z')
13 op_ct = '\0';
14
15 SEXP to = PROTECT(newObject(class));
16
17 int *pdim = DIM(from), m = pdim[0], n = pdim[1];
18 SET_DIM(to, n, m);
19 SET_DIMNAMES(to, class[1] != 's' && class[1] != 'p' && class[1] != 'o', DIMNAMES(from, 0));
20 if (class[1] != 'g' && (ul = UPLO(from)) == 'U')
21 SET_UPLO(to);
22 if (class[1] == 's' && class[0] == 'z' && TRANS(from) != 'C')
23 SET_TRANS(to);
24 if (class[1] == 't' && DIAG(from) != 'N')
25 SET_DIAG(to);
26 if (class[1] == 'o')
27 COPY_SLOT(to, from, Matrix_sdSym);
28
29 SEXP x0 = PROTECT(GET_SLOT(from, Matrix_xSym)),
30 x1 = PROTECT(Rf_allocVector(TYPEOF(x0), XLENGTH(x0)));
31 size_t m_ = (size_t) m, n_ = (size_t) n;
32
33#define TEMPLATE(c) \
34 do { \
35 c##TYPE *px0 = c##PTR(x0), *px1 = c##PTR(x1); \
36 if (!packed) \
37 c##NAME(trans2)(px1, px0, m_, n_, op_ct); \
38 else \
39 c##NAME(trans1)(px1, px0, n_, ul, op_ct); \
40 } while (0)
41
42 SWITCH4((class[0] == 'c') ? 'd' : class[0], TEMPLATE);
43
44#undef TEMPLATE
45
46 SET_SLOT(to, Matrix_xSym, x1);
47
48 UNPROTECT(3); /* x1, x0, to */
49 return to;
50}
51
52SEXP sparse_transpose(SEXP from, const char *class, char op_ct,
53 int lazy)
54{
55 if (class[0] != 'z')
56 op_ct = '\0';
57
58 SEXP to;
59 if (class[2] == 'T' || !lazy)
60 PROTECT(to = newObject(class));
61 else {
62 char cl[] = "...Matrix";
63 cl[0] = class[0];
64 cl[1] = class[1];
65 cl[2] = (class[2] == 'C') ? 'R' : 'C';
66 PROTECT(to = newObject(cl));
67 }
68
69 int *pdim = DIM(from), m = pdim[0], n = pdim[1];
70 SET_DIM(to, n, m);
71 SET_DIMNAMES(to, class[1] != 's' && class[1] != 'p', DIMNAMES(from, 0));
72 if (class[1] != 'g' && UPLO(from) == 'U')
73 SET_UPLO(to);
74 if (class[1] == 's' && class[0] == 'z' && TRANS(from) != 'C')
75 SET_TRANS(to);
76 if (class[1] == 't' && DIAG(from) != 'N')
77 SET_DIAG(to);
78
79 if (class[2] != 'T') {
80
81 if (class[2] == 'R')
82 SWAP(m, n, int, );
83
84 SEXP iSym = (class[2] == 'C') ? Matrix_iSym : Matrix_jSym,
85 jSym = (class[2] == 'C') ? Matrix_jSym : Matrix_iSym,
86 p0 = PROTECT(GET_SLOT(from, Matrix_pSym)),
87 i0 = PROTECT(GET_SLOT(from, iSym));
88 int *pp0 = INTEGER(p0), *pi0 = INTEGER(i0), nnz = INTEGER(p0)[n];
89
90 if (lazy) {
91
92 SET_SLOT(to, Matrix_pSym, p0);
93 SET_SLOT(to, jSym, i0);
94
95 if (class[0] != 'n') {
96 SEXP x0 = PROTECT(GET_SLOT(from, Matrix_xSym));
97 if (op_ct != 'C')
98 SET_SLOT(to, Matrix_xSym, x0);
99 else {
100 SEXP x1 = PROTECT(Rf_allocVector(CPLXSXP, nnz));
101 zvconj(COMPLEX(x1), COMPLEX(x0), (size_t) nnz);
102 SET_SLOT(to, Matrix_xSym, x1);
103 UNPROTECT(1); /* x1 */
104 }
105 UNPROTECT(1); /* x0 */
106 }
107
108 } else {
109
110 SEXP p1 = PROTECT(Rf_allocVector(INTSXP, (R_xlen_t) m + 1)),
111 i1 = PROTECT(Rf_allocVector(INTSXP, nnz));
112 int *pp1 = INTEGER(p1), *pi1 = INTEGER(i1), *iwork = NULL;
113 SET_SLOT(to, Matrix_pSym, p1);
114 SET_SLOT(to, iSym, i1);
115 Matrix_Calloc(iwork, m, int);
116
117#define TEMPLATE(c) \
118 do { \
119 c##TYPE *px0 = NULL, *px1 = NULL; \
120 c##IF_NPATTERN( \
121 SEXP x0 = PROTECT(GET_SLOT(from, Matrix_xSym)), \
122 x1 = PROTECT(Rf_allocVector(c##TYPESXP, nnz)); \
123 px0 = c##PTR(x0); \
124 px1 = c##PTR(x1); \
125 SET_SLOT(to, Matrix_xSym, x1); \
126 UNPROTECT(2); /* x1, x0 */ \
127 ); \
128 c##csptrans(pp1, pi1, px1, pp0, pi0, px0, m, n, op_ct, iwork); \
129 } while (0)
130
131 SWITCH5(class[0], TEMPLATE);
132
133#undef TEMPLATE
134
135 Matrix_Free(iwork, m);
136 UNPROTECT(2); /* j1, p1 */
137
138 }
139
140 UNPROTECT(2); /* i0, p0 */
141
142 } else {
143
144 SEXP i0 = PROTECT(GET_SLOT(from, Matrix_iSym)),
145 j0 = PROTECT(GET_SLOT(from, Matrix_jSym));
146 SET_SLOT(to, Matrix_iSym, j0);
147 SET_SLOT(to, Matrix_jSym, i0);
148
149 if (class[0] != 'n') {
150 SEXP x0 = PROTECT(GET_SLOT(from, Matrix_xSym));
151 if (op_ct != 'C')
152 SET_SLOT(to, Matrix_xSym, x0);
153 else {
154 SEXP x1 = PROTECT(Rf_allocVector(CPLXSXP, XLENGTH(x0)));
155 zvconj(COMPLEX(x1), COMPLEX(x0), (size_t) XLENGTH(x0));
156 SET_SLOT(to, Matrix_xSym, x1);
157 UNPROTECT(1); /* x1 */
158 }
159 UNPROTECT(1); /* x0 */
160 }
161
162 UNPROTECT(2); /* j0, i0 */
163
164 }
165
166 UNPROTECT(1); /* to */
167 return to;
168}
169
170SEXP R_dense_transpose(SEXP s_from, SEXP s_trans)
171{
172 const char *class = Matrix_class(s_from, valid_dense, 0, __func__);
173
174 char ct;
175 VALID_TRANS(s_trans, ct);
176
177 return dense_transpose(s_from, class, ct);
178}
179
180SEXP R_sparse_transpose(SEXP s_from, SEXP s_trans, SEXP s_lazy)
181{
182 const char *class = Matrix_class(s_from, valid_sparse, 0, __func__);
183
184 char ct;
185 VALID_TRANS(s_trans, ct);
186
187 int lazy;
188 VALID_LOGIC2(s_lazy, lazy);
189
190 return sparse_transpose(s_from, class, ct, lazy);
191}
#define SWITCH5(c, template)
Definition M5.h:327
#define SWITCH4(c, template)
Definition M5.h:315
#define SET_DIM(x, m, n)
Definition Mdefines.h:87
#define SWAP(a, b, t, op)
Definition Mdefines.h:138
const char * valid_dense[]
Definition objects.c:3
#define Matrix_Calloc(p, n, t)
Definition Mdefines.h:45
#define SET_UPLO(x)
Definition Mdefines.h:103
#define DIAG(x)
Definition Mdefines.h:111
#define UPLO(x)
Definition Mdefines.h:101
#define SET_DIMNAMES(x, mode, value)
Definition Mdefines.h:98
const char * Matrix_class(SEXP, const char **, int, const char *)
Definition objects.c:112
#define Matrix_Free(p, n)
Definition Mdefines.h:56
#define DIMNAMES(x, mode)
Definition Mdefines.h:96
#define SET_TRANS(x)
Definition Mdefines.h:108
#define TRANS(x)
Definition Mdefines.h:106
#define SET_DIAG(x)
Definition Mdefines.h:113
#define DIM(x)
Definition Mdefines.h:85
#define GET_SLOT(x, name)
Definition Mdefines.h:72
#define VALID_TRANS(s, c)
Definition Mdefines.h:166
SEXP newObject(const char *)
Definition objects.c:13
#define COPY_SLOT(dest, src, name)
Definition Mdefines.h:75
const char * valid_sparse[]
Definition Mdefines.h:328
#define SET_SLOT(x, name, value)
Definition Mdefines.h:73
#define VALID_LOGIC2(s, d)
Definition Mdefines.h:216
#define TYPEOF(s)
Definition Mdefines.h:123
cholmod_common cl
Definition cholmod-etc.c:6
void zvconj(Rcomplex *x, const Rcomplex *y, size_t n)
Definition idz.c:1300
SEXP Matrix_sdSym
Definition init.c:629
SEXP Matrix_xSym
Definition init.c:635
SEXP Matrix_iSym
Definition init.c:607
SEXP Matrix_jSym
Definition init.c:610
SEXP Matrix_pSym
Definition init.c:622
SEXP R_dense_transpose(SEXP s_from, SEXP s_trans)
Definition t.c:170
SEXP sparse_transpose(SEXP from, const char *class, char op_ct, int lazy)
Definition t.c:52
#define TEMPLATE(c)
SEXP dense_transpose(SEXP from, const char *class, char op_ct)
Definition t.c:7
SEXP R_sparse_transpose(SEXP s_from, SEXP s_trans, SEXP s_lazy)
Definition t.c:180