1
#include <Rcpp.h>
2
using namespace Rcpp;
3

4
// Currently, these functions are used verbatim from tidyr
5
//   https://github.com/tidyverse/tidyr/blob/master/src/fill.cpp
6

7
// [[Rcpp::export]]
8 1
SEXP fillDown(SEXP x) {
9 1
  int n = Rf_length(x);
10 1
  SEXP out = Rf_allocVector(TYPEOF(x), n);
11

12 1
  switch(TYPEOF(x)) {
13
  case LGLSXP: {
14 1
    int* xin = LOGICAL(x);
15 1
    int* xout = LOGICAL(out);
16

17 1
    int lastVal = xin[0];
18

19 1
    for (int i = 0; i < n; ++i) {
20 1
      if (xin[i] != NA_LOGICAL)
21 1
        lastVal = xin[i];
22 1
      xout[i] = lastVal;
23
    }
24 1
    break;
25
  }
26
  case INTSXP: {
27 1
    int* xin = INTEGER(x);
28 1
    int* xout = INTEGER(out);
29

30 1
    int lastVal = xin[0];
31

32 1
    for (int i = 0; i < n; ++i) {
33 1
      if (xin[i] != NA_INTEGER)
34 1
        lastVal = xin[i];
35 1
      xout[i] = lastVal;
36
    }
37 1
    break;
38

39
  }
40
  case REALSXP: {
41 1
    double* xin = REAL(x);
42 1
    double* xout = REAL(out);
43

44 1
    double lastVal = xin[0];
45

46 1
    for (int i = 0; i < n; ++i) {
47 1
      if (!ISNA(xin[i]))
48 1
        lastVal = xin[i];
49 1
      xout[i] = lastVal;
50
    }
51 1
    break;
52

53
  }
54
  case STRSXP: {
55 1
    SEXP lastVal = NA_STRING;
56

57 1
    for (int i = 0; i < n; ++i) {
58 1
      if (STRING_ELT(x, i) != NA_STRING)
59 1
        lastVal = STRING_ELT(x, i);
60 1
      SET_STRING_ELT(out, i, lastVal);
61
    }
62 1
    break;
63

64
  }
65
  case VECSXP: {
66 1
    SEXP lastVal = R_NilValue;
67

68 1
    for (int i = 0; i < n; ++i) {
69 1
      if (!Rf_isNull(VECTOR_ELT(x, i)))
70 1
        lastVal = VECTOR_ELT(x, i);
71 1
      SET_VECTOR_ELT(out, i, lastVal);
72
    }
73 1
    break;
74

75
  }
76
  default:
77 0
    stop("Don't know how to handle column of type", Rf_type2char(TYPEOF(x)));
78
  }
79

80 1
  Rf_copyMostAttrib(x, out);
81 1
  return out;
82
}
83

84

85
// [[Rcpp::export]]
86 1
SEXP fillUp(SEXP x) {
87 1
  int n = Rf_length(x);
88 1
  SEXP out = Rf_allocVector(TYPEOF(x), n);
89

90 1
  switch(TYPEOF(x)) {
91
  case LGLSXP: {
92 1
    int* xin = LOGICAL(x);
93 1
    int* xout = LOGICAL(out);
94

95 1
    int lastVal = xin[n - 1];
96

97 1
    for (int i = n - 1; i >= 0; --i) {
98 1
      if (xin[i] != NA_LOGICAL)
99 1
        lastVal = xin[i];
100 1
      xout[i] = lastVal;
101
    }
102 1
    break;
103
  }
104
  case INTSXP: {
105 1
    int* xin = INTEGER(x);
106 1
    int* xout = INTEGER(out);
107

108 1
    int lastVal = xin[n - 1];
109

110 1
    for (int i = n - 1; i >= 0; --i) {
111 1
      if (xin[i] != NA_INTEGER)
112 1
        lastVal = xin[i];
113 1
      xout[i] = lastVal;
114
    }
115 1
    break;
116

117
  }
118
  case REALSXP: {
119 1
    double* xin = REAL(x);
120 1
    double* xout = REAL(out);
121

122 1
    double lastVal = xin[n - 1];
123

124 1
    for (int i = n - 1; i >= 0; --i) {
125 1
      if (!ISNA(xin[i]))
126 1
        lastVal = xin[i];
127 1
      xout[i] = lastVal;
128
    }
129 1
    break;
130

131
  }
132
  case STRSXP: {
133 1
    SEXP lastVal = NA_STRING;
134

135 1
    for (int i = n - 1; i >= 0; --i) {
136 1
      if (STRING_ELT(x, i) != NA_STRING)
137 1
        lastVal = STRING_ELT(x, i);
138 1
      SET_STRING_ELT(out, i, lastVal);
139
    }
140 1
    break;
141

142
  }
143
  case VECSXP: {
144 1
    SEXP lastVal = R_NilValue;
145

146 1
    for (int i = n - 1; i >= 0; --i) {
147 1
      if (!Rf_isNull(VECTOR_ELT(x, i)))
148 1
        lastVal = VECTOR_ELT(x, i);
149 1
      SET_VECTOR_ELT(out, i, lastVal);
150
    }
151 1
    break;
152

153
  }
154
  default:
155 0
    stop("Don't know how to handle column of type", Rf_type2char(TYPEOF(x)));
156
  }
157

158 1
  Rf_copyMostAttrib(x, out);
159 1
  return out;
160
}

Read our documentation on viewing source code .

Loading