3int isPerm(
const int *p,
int n,
int off)
11 for (i = 0; i < n; ++i) {
12 if (p[i] == NA_INTEGER || (j = p[i] - off) < 0 || j >= n || work[j]) {
25 Rf_error(
_(
"attempt to get sign of non-permutation"));
40 while (pos < n && work[pos])
47void invertPerm(
const int *p,
int *ip,
int n,
int off,
int ioff)
50 Rf_error(
_(
"attempt to invert non-permutation"));
52 for (j = 0; j < n; ++j)
53 ip[p[j] - off] = j + ioff;
57void asPerm(
const int *p,
int *ip,
int m,
int n,
int off,
int ioff)
60 for (i = 0; i < n; ++i)
62 for (i = 0; i < m; ++i) {
65 Rf_error(
_(
"invalid transposition vector"));
78 Rf_error(
_(
"'%s' is not of type \"%s\""),
"p",
"integer");
79 if (
TYPEOF(s_off) != INTSXP)
80 Rf_error(
_(
"'%s' is not of type \"%s\""),
"off",
"integer");
81 if (XLENGTH(s_off) != 1)
82 Rf_error(
_(
"'%s' does not have length %d"),
"off", 1);
83 int off = INTEGER(s_off)[0];
84 if (off == NA_INTEGER)
85 Rf_error(
_(
"'%s' is NA"),
"off");
86 R_xlen_t n = XLENGTH(s_p);
88 return Rf_ScalarLogical(0);
89 return Rf_ScalarLogical(
isPerm(INTEGER(s_p), (
int) n, off));
95 Rf_error(
_(
"'%s' is not of type \"%s\""),
"p",
"integer");
96 if (
TYPEOF(s_off) != INTSXP)
97 Rf_error(
_(
"'%s' is not of type \"%s\""),
"off",
"integer");
98 if (XLENGTH(s_off) != 1)
99 Rf_error(
_(
"'%s' does not have length %d"),
"off", 1);
100 int off = INTEGER(s_off)[0];
101 if (off == NA_INTEGER)
102 Rf_error(
_(
"'%s' is NA"),
"off");
103 R_xlen_t n = XLENGTH(s_p);
105 Rf_error(
_(
"attempt to get sign of non-permutation"));
106 return Rf_ScalarInteger(
signPerm(INTEGER(s_p), (
int) n, off));
111 if (
TYPEOF(s_p) != INTSXP)
112 Rf_error(
_(
"'%s' is not of type \"%s\""),
114 if (
TYPEOF(s_off) != INTSXP ||
TYPEOF(s_ioff) != INTSXP)
115 Rf_error(
_(
"'%s' or '%s' is not of type \"%s\""),
116 "off",
"ioff",
"integer");
117 if (XLENGTH(s_off) != 1 || XLENGTH(s_ioff) != 1)
118 Rf_error(
_(
"'%s' or '%s' does not have length %d"),
120 int off = INTEGER(s_off)[0], ioff = INTEGER(s_ioff)[0];
121 if (off == NA_INTEGER || ioff == NA_INTEGER)
122 Rf_error(
_(
"'%s' or '%s' is NA"),
124 R_xlen_t n = XLENGTH(s_p);
126 Rf_error(
_(
"attempt to invert non-permutation"));
127 SEXP ip = PROTECT(Rf_allocVector(INTSXP, n));
128 invertPerm(INTEGER(s_p), INTEGER(ip), (
int) n, off, ioff);
133SEXP
R_asPerm(SEXP s_p, SEXP s_off, SEXP s_ioff, SEXP s_n)
135 if (
TYPEOF(s_p) != INTSXP)
136 Rf_error(
_(
"'%s' is not of type \"%s\""),
138 R_xlen_t m = XLENGTH(s_p);
140 Rf_error(
_(
"'%s' has length exceeding %s"),
142 if (
TYPEOF(s_off) != INTSXP ||
TYPEOF(s_ioff) != INTSXP)
143 Rf_error(
_(
"'%s' or '%s' is not of type \"%s\""),
144 "off",
"ioff",
"integer");
145 if (XLENGTH(s_off) != 1 || XLENGTH(s_ioff) != 1)
146 Rf_error(
_(
"'%s' or '%s' does not have length %d"),
148 int off = INTEGER(s_off)[0], ioff = INTEGER(s_ioff)[0];
149 if (off == NA_INTEGER || ioff == NA_INTEGER)
150 Rf_error(
_(
"'%s' or '%s' is NA"),
152 if (
TYPEOF(s_n) != INTSXP)
153 Rf_error(
_(
"'%s' is not of type \"%s\""),
155 if (XLENGTH(s_n) != 1)
156 Rf_error(
_(
"'%s' does not have length %d"),
158 int n = INTEGER(s_n)[0];
159 if (n == NA_INTEGER || n < m)
160 Rf_error(
_(
"'%s' is NA or less than %s"),
162 SEXP ip = PROTECT(Rf_allocVector(INTSXP, n));
163 asPerm(INTEGER(s_p), INTEGER(ip), (
int) m, n, off, ioff);
#define Matrix_Calloc(p, n, t)
#define Matrix_Free(p, n)
SEXP R_invertPerm(SEXP s_p, SEXP s_off, SEXP s_ioff)
void asPerm(const int *p, int *ip, int m, int n, int off, int ioff)
SEXP R_signPerm(SEXP s_p, SEXP s_off)
SEXP R_asPerm(SEXP s_p, SEXP s_off, SEXP s_ioff, SEXP s_n)
int isPerm(const int *p, int n, int off)
void invertPerm(const int *p, int *ip, int n, int off, int ioff)
SEXP R_isPerm(SEXP s_p, SEXP s_off)
int signPerm(const int *p, int n, int off)