Matrix r5059
Loading...
Searching...
No Matches
isDiagonal.c
Go to the documentation of this file.
1/* C implementation of methods for isDiagonal */
2
3#include "Mdefines.h"
4#include "M5.h"
5#include "idz.h"
6
7int dense_is_diagonal(SEXP obj, const char *class)
8{
9 int *pdim = DIM(obj), n = pdim[1];
10 if (pdim[0] != n)
11 return 0;
12 if (n <= 1)
13 return 1;
14
15 char ul = '\0';
16 if (class[1] != 'g')
17 ul = UPLO(obj);
18
19 SEXP x = GET_SLOT(obj, Matrix_xSym);
20 int packed = class[2] == 'p';
21
22#define TEMPLATE(c) \
23 do { \
24 c##TYPE *px = c##PTR(x); \
25 if (class[1] == 'g') { \
26 if (c##NAME(test2)(px, (size_t) n, '\0', '\0', -'N')) \
27 return 0; \
28 } else if (!packed) { \
29 ul = (ul == 'U') ? 'L' : 'U'; \
30 if (c##NAME(test2)(px, (size_t) n, ul, '\0', 'N')) \
31 return 0; \
32 } else { \
33 if (c##NAME(test1)(px, (size_t) n, ul, '\0', -'N')) \
34 return 0; \
35 } \
36 } while (0)
37
38 SWITCH4(class[0], TEMPLATE);
39
40#undef TEMPLATE
41
42 return 1;
43}
44
45int sparse_is_diagonal(SEXP obj, const char *class)
46{
47 int *pdim = DIM(obj), n = pdim[1];
48 if (pdim[0] != n)
49 return 0;
50 if (n <= 1)
51 return 1;
52
53 if (class[2] != 'T') {
54
55 SEXP iSym = (class[2] == 'C') ? Matrix_iSym : Matrix_jSym,
56 p = PROTECT(GET_SLOT(obj, Matrix_pSym)),
57 i = PROTECT(GET_SLOT(obj, iSym));
58 int *pp = INTEGER(p), *pi = INTEGER(i), j, k, kend;
59 pp++;
60 UNPROTECT(2); /* i, p */
61
62 for (j = 0, k = 0; j < n; ++j) {
63 kend = pp[j];
64 if (k < kend && (kend - k > 1 || pi[k] != j))
65 return 0;
66 k = kend;
67 }
68 return 1;
69
70 } else {
71
72 SEXP i = PROTECT(GET_SLOT(obj, Matrix_iSym)),
73 j = PROTECT(GET_SLOT(obj, Matrix_jSym));
74 int *pi = INTEGER(i), *pj = INTEGER(j);
75 R_xlen_t k, kend = XLENGTH(i);
76 UNPROTECT(2); /* j, i */
77
78 for (k = 0; k < kend; ++k)
79 if (pi[k] != pj[k])
80 return 0;
81 return 1;
82
83 }
84}
85
86SEXP R_dense_is_diagonal(SEXP s_obj)
87{
88 if (TYPEOF(s_obj) != OBJSXP) {
89 /* defined in ./coerce.c : */
90 SEXP matrix_as_dense(SEXP, const char *, char, char, char, int, int);
91 s_obj = matrix_as_dense(s_obj, ".ge", '\0', '\0', '\0', 1, 0);
92 }
93 PROTECT(s_obj);
94 const char *class = Matrix_class(s_obj, valid_dense, 6, __func__);
95
96 int ans_ = dense_is_diagonal(s_obj, class);
97 SEXP ans = Rf_ScalarLogical(ans_ != 0);
98 UNPROTECT(1);
99 return ans;
100}
101
102/* NB: requires diagonal nonzero pattern */
103SEXP R_sparse_is_diagonal(SEXP s_obj)
104{
105 const char *class = Matrix_class(s_obj, valid_sparse, 6, __func__);
106 return Rf_ScalarLogical(sparse_is_diagonal(s_obj, class));
107}
#define SWITCH4(c, template)
Definition M5.h:315
const char * valid_dense[]
Definition objects.c:3
#define UPLO(x)
Definition Mdefines.h:101
const char * Matrix_class(SEXP, const char **, int, const char *)
Definition objects.c:112
#define DIM(x)
Definition Mdefines.h:85
#define GET_SLOT(x, name)
Definition Mdefines.h:72
const char * valid_sparse[]
Definition Mdefines.h:328
#define TYPEOF(s)
Definition Mdefines.h:123
SEXP matrix_as_dense(SEXP from, const char *zzz, char ul, char ct, char nu, int mg, int new)
Definition coerce.c:262
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_sparse_is_diagonal(SEXP s_obj)
Definition isDiagonal.c:103
#define TEMPLATE(c)
SEXP R_dense_is_diagonal(SEXP s_obj)
Definition isDiagonal.c:86
int dense_is_diagonal(SEXP obj, const char *class)
Definition isDiagonal.c:7
int sparse_is_diagonal(SEXP obj, const char *class)
Definition isDiagonal.c:45