Matrix  $Rev: 3071 $ at $LastChangedDate: 2015-03-26 15:35:47 +0100 (Thu, 26 Mar 2015) $
t_Matrix_rle.c
Go to the documentation of this file.
1 /*------ Definition of a template for Matrix_rle_[di](...) : *
2  * -------- ~~~~~~~~~~~~~~~~~~~~~~
3  * i.e., included several times from ./abIndex.c
4  * ~~~~~~~~~~~
5  */
6 
7 /* for all cases with an 'x' slot -- i.e. almost all cases ;
8  * just redefine this in the other cases:
9  */
10 
11 #ifdef _rle_d_
12 
13 # define Matrix_RLE_ Matrix_rle_d
14 # define Type_x_ double
15 # define STYP_x_ REAL
16 # define SXP_ans REALSXP
17 
18 #elif defined _rle_i_
19 
20 # define Matrix_RLE_ Matrix_rle_i
21 # define Type_x_ int
22 # define STYP_x_ INTEGER
23 # define SXP_ans INTSXP
24 
25 #else
26 # error "invalid _rle_ macro logic"
27 #endif
28 
37 SEXP Matrix_RLE_(SEXP x_, SEXP force_)
38 {
39  int n = LENGTH(PROTECT(x_ = coerceVector(x_, SXP_ans)));
40  Rboolean no_force = !asLogical(force_);
41  if (no_force && n < 3) {
42  UNPROTECT(1); return R_NilValue;
43  } else {
44  register Type_x_ lv;
45  register int ln, i, c = 0;
46  int n2 = (no_force) ? n / 3 : n;
47  /* upper bound: ==> max RAM requirement 2 x n2, (= 2/3 n);
48  * using 2 instead of 3 would need 50% more time, have max
49  * RAM requirement 2.5x for savings of any size */
50  Type_x_ *x = STYP_x_(x_), *val;
51  int *len;
52  const char *res_nms[] = {"lengths", "values", ""};
53  SEXP ans;
54  if(n > 0) { /* needed for force=TRUE */
55  len = Calloc(n2, int);
56  val = Calloc(n2, Type_x_);
57 
58  lv = x[0];
59  ln = 1;
60  for(i = 1; i < n; i++) {
61  if (x[i] == lv) {
62  ln++;
63  } else {
64  val[c] = lv;
65  len[c] = ln;
66  c++;
67  if (no_force && c == n2) { /* reached the "efficiency bound" */
68  Free(len);
69  Free(val);
70  UNPROTECT(1); return R_NilValue;
71  }
72  lv = x[i];
73  ln = 1;
74  }
75  }
76  val[c] = lv;
77  len[c] = ln;
78  c++;
79  }
80  ans = PROTECT(Rf_mkNamed(VECSXP, res_nms));
81  SET_VECTOR_ELT(ans, 0, allocVector(INTSXP, c)); /* lengths */
82  SET_VECTOR_ELT(ans, 1, allocVector(SXP_ans, c)); /* values */
83  if(n > 0) {
84  Memcpy(INTEGER(VECTOR_ELT(ans, 0)), len, c);
85  Memcpy(STYP_x_(VECTOR_ELT(ans, 1)), val, c);
86  }
87  setAttrib(ans, R_ClassSymbol, mkString("rle"));
88 
89  if(n > 0) { Free(len); Free(val); }
90  UNPROTECT(2);
91  return ans;
92  }
93 } /* Matrix_RLE_() template */
94 
95 #undef Matrix_RLE_
96 #undef Type_x_
97 #undef STYP_x_
98 #undef SXP_ans
SEXP Matrix_RLE_(SEXP x_, SEXP force_)
RLE (Run Length Encoding) – only when it's worth.
Definition: t_Matrix_rle.c:37
cholmod_common c
Definition: chm_common.c:15