#30 Add `last` and `endpoint` arguments to `warp_change()`

Open Davis Vaughan DavisVaughan

No flags found

Use flags to group coverage reports by test type, project and/or folders.
Then setup custom commit statuses and notifications for each flag.

e.g., #unittest #integration

#production #enterprise

#frontend #backend

Learn more about Codecov Flags here.

Showing 5 of 11 files from the diff.

@@ -7,8 +7,12 @@
Loading
7 7
8 8
// [[ include("warp.h") ]]
9 9
SEXP warp_boundary(SEXP x, enum warp_period_type type, int every, SEXP origin) {
10 -
  SEXP stops = PROTECT(warp_change(x, type, every, origin));
10 +
  static const bool last = true;
11 +
  static const bool endpoint = false;
12 +
13 +
  SEXP stops = PROTECT(warp_change(x, type, every, origin, last, endpoint));
11 14
  SEXP out = warp_boundary_impl(stops);
15 +
12 16
  UNPROTECT(1);
13 17
  return out;
14 18
}

@@ -5,7 +5,7 @@
Loading
5 5
6 6
/* .Call calls */
7 7
extern SEXP warp_warp_distance(SEXP, SEXP, SEXP, SEXP);
8 -
extern SEXP warp_warp_change(SEXP, SEXP, SEXP, SEXP);
8 +
extern SEXP warp_warp_change(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP);
9 9
extern SEXP warp_warp_boundary(SEXP, SEXP, SEXP, SEXP);
10 10
11 11
extern SEXP warp_class_type(SEXP);
@@ -19,7 +19,7 @@
Loading
19 19
20 20
static const R_CallMethodDef CallEntries[] = {
21 21
  {"warp_warp_distance",         (DL_FUNC) &warp_warp_distance, 4},
22 -
  {"warp_warp_change",           (DL_FUNC) &warp_warp_change, 4},
22 +
  {"warp_warp_change",           (DL_FUNC) &warp_warp_change, 6},
23 23
  {"warp_warp_boundary",         (DL_FUNC) &warp_warp_boundary, 4},
24 24
  {"warp_class_type",            (DL_FUNC) &warp_class_type, 1},
25 25
  {"warp_date_get_year_offset",  (DL_FUNC) &warp_date_get_year_offset, 1},

@@ -1,21 +1,60 @@
Loading
1 1
#' Detect changes in a date time vector
2 2
#'
3 -
#' `warp_change()` detects changes at the `period` level. It returns the
4 -
#' locations of the value just before a change. The location of the last
5 -
#' value in `x` is always returned at the end.
3 +
#' @description
4 +
#' `warp_change()` detects changes at the `period` level.
5 +
#'
6 +
#' If `last = TRUE`, it returns locations of the last value before a change,
7 +
#' and the last location in `x` is always included. Additionally, if
8 +
#' `endpoint = TRUE`, the first location in `x` will be included.
9 +
#'
10 +
#' If `last = FALSE`, it returns locations of the first value after a change,
11 +
#' and the first location in `x` is always included. Additionally, if
12 +
#' `endpoint = TRUE`, the last location in `x` will be included.
6 13
#'
7 14
#' @inheritParams warp_distance
8 15
#'
16 +
#' @param last `[logical(1)]`
17 +
#'
18 +
#'   If `TRUE`, the _last_ location _before_ a change is returned.
19 +
#'   The last location of the input is always returned.
20 +
#'
21 +
#'   If `FALSE`, the _first_ location _after_ a change is returned.
22 +
#'   The first location of the input is always returned.
23 +
#'
24 +
#' @param endpoint `[logical(1)]`
25 +
#'
26 +
#'   If `TRUE` and `last = TRUE`, will additionally return the first location
27 +
#'   of the input.
28 +
#'
29 +
#'   If `TRUE` and `last = FALSE`, will additionally return the last location
30 +
#'   of the input.
31 +
#'
32 +
#'   If `FALSE`, does nothing.
33 +
#'
9 34
#' @return
10 -
#' A double vector of locations right before a change.
35 +
#' A double vector of locations.
11 36
#'
12 37
#' @export
13 38
#' @examples
14 39
#' x <- as.Date("2019-01-01") + 0:5
40 +
#' x
41 +
#'
42 +
#' # Last location before a change, last location of `x` is always included
43 +
#' warp_change(x, period = "yday", every = 2, last = TRUE)
44 +
#'
45 +
#' # Also include first location
46 +
#' warp_change(x, period = "yday", every = 2, last = TRUE, endpoint = TRUE)
15 47
#'
16 -
#' warp_change(x, period = "day", every = 2)
48 +
#' # First location after a change, first location of `x` is always included
49 +
#' warp_change(x, period = "yday", every = 2, last = FALSE)
17 50
#'
18 -
#' warp_change(x, period = "day", every = 2, origin = as.Date("2019-01-01"))
19 -
warp_change <- function(x, period, every = 1L, origin = NULL) {
20 -
  .Call(warp_warp_change, x, period, every, origin)
51 +
#' # Also include last location
52 +
#' warp_change(x, period = "yday", every = 2, last = FALSE, endpoint = TRUE)
53 +
warp_change <- function(x,
54 +
                        period,
55 +
                        every = 1L,
56 +
                        origin = NULL,
57 +
                        last = TRUE,
58 +
                        endpoint = FALSE) {
59 +
  .Call(warp_warp_change, x, period, every, origin, last, endpoint)
21 60
}

@@ -3,47 +3,72 @@
Loading
3 3
4 4
// -----------------------------------------------------------------------------
5 5
6 -
static SEXP warp_change_impl(SEXP x);
6 +
static SEXP warp_change_impl(SEXP x, bool last, bool endpoint);
7 7
8 8
// [[ include("warp.h") ]]
9 -
SEXP warp_change(SEXP x, enum warp_period_type type, int every, SEXP origin) {
10 -
  SEXP distances = PROTECT(warp_distance(x, type, every, origin));
11 -
  SEXP out = warp_change_impl(distances);
9 +
SEXP warp_change(SEXP x,
10 +
                 enum warp_period_type period,
11 +
                 int every,
12 +
                 SEXP origin,
13 +
                 bool last,
14 +
                 bool endpoint) {
15 +
  SEXP distances = PROTECT(warp_distance(x, period, every, origin));
16 +
  SEXP out = warp_change_impl(distances, last, endpoint);
12 17
  UNPROTECT(1);
13 18
  return out;
14 19
}
15 20
16 21
// [[ register() ]]
17 -
SEXP warp_warp_change(SEXP x, SEXP period, SEXP every, SEXP origin) {
18 -
  enum warp_period_type type = as_period_type(period);
22 +
SEXP warp_warp_change(SEXP x,
23 +
                      SEXP period,
24 +
                      SEXP every,
25 +
                      SEXP origin,
26 +
                      SEXP last,
27 +
                      SEXP endpoint) {
28 +
  enum warp_period_type period_ = as_period_type(period);
19 29
  int every_ = pull_every(every);
20 -
  return warp_change(x, type, every_, origin);
30 +
  bool last_ = pull_last(last);
31 +
  bool endpoint_ = pull_endpoint(endpoint);
32 +
  return warp_change(x, period_, every_, origin, last_, endpoint_);
21 33
}
22 34
23 35
// -----------------------------------------------------------------------------
24 36
25 37
static inline bool dbl_equal(const double current, const double previous);
26 38
27 -
static SEXP warp_change_impl(SEXP x) {
28 -
  R_xlen_t size = Rf_xlength(x);
39 +
static SEXP warp_change_impl(SEXP x, bool last, bool endpoint) {
40 +
  const R_xlen_t size = Rf_xlength(x);
29 41
30 42
  if (size == 0) {
31 43
    return Rf_allocVector(REALSXP, 0);
32 44
  }
33 -
34 45
  if (size == 1) {
35 46
    return Rf_ScalarReal(1);
36 47
  }
37 48
38 -
  int count = 0;
39 -
  int pos_last = 0;
49 +
  R_xlen_t count = 0;
40 50
41 51
  // Maximum size is if all values are unique
42 52
  SEXP out = PROTECT(Rf_allocVector(REALSXP, size));
43 53
  double* p_out = REAL(out);
44 54
45 55
  const double* p_x = REAL(x);
46 56
57 +
  if (last) {
58 +
    // If the location of the first changepoint
59 +
    // wasn't the first location in `x`, we need to forcibly add the endpoint
60 +
    if (endpoint && dbl_equal(p_x[0], p_x[1])) {
61 +
      p_out[count] = 1;
62 +
      ++count;
63 +
    }
64 +
  } else {
65 +
    // Always include first value when returning starts
66 +
    p_out[count] = 1;
67 +
    ++count;
68 +
  }
69 +
70 +
  const R_xlen_t adjustment = (R_xlen_t) !last;
71 +
47 72
  double previous = p_x[0];
48 73
49 74
  for (R_xlen_t i = 1; i < size; ++i) {
@@ -53,21 +78,28 @@
Loading
53 78
      continue;
54 79
    }
55 80
56 -
    // R indexed, and really `- 1 + 1`
57 -
    p_out[count] = i;
81 +
    const R_xlen_t loc = i + adjustment;
82 +
83 +
    p_out[count] = loc;
58 84
59 -
    count++;
60 -
    pos_last = i;
85 +
    ++count;
61 86
    previous = current;
62 87
  }
63 88
64 -
  // Always include the last value
65 -
  if (pos_last != size) {
89 +
  if (last) {
90 +
    // Always include last value when returning stops
66 91
    p_out[count] = size;
67 -
    count++;
92 +
    ++count;
93 +
  } else {
94 +
    // If the location of the last changepoint
95 +
    // wasn't the last location in `x`, we need to forcibly add the endpoint
96 +
    if (endpoint && dbl_equal(p_x[size - 2], p_x[size - 1])) {
97 +
      p_out[count] = size;
98 +
      ++count;
99 +
    }
68 100
  }
69 101
70 -
  out = PROTECT(Rf_lengthgets(out, count));
102 +
  out = PROTECT(Rf_xlengthgets(out, count));
71 103
72 104
  UNPROTECT(2);
73 105
  return out;

@@ -105,6 +105,42 @@
Loading
105 105
106 106
// -----------------------------------------------------------------------------
107 107
108 +
// [[ include("utils.h") ]]
109 +
bool pull_endpoint(SEXP endpoint) {
110 +
  if (Rf_length(endpoint) != 1) {
111 +
    r_error("pull_endpoint", "`endpoint` must have size 1, not %i", Rf_length(endpoint));
112 +
  }
113 +
114 +
  if (OBJECT(endpoint) != 0) {
115 +
    r_error("pull_endpoint", "`endpoint` must be a bare logical value.");
116 +
  }
117 +
118 +
  switch (TYPEOF(endpoint)) {
119 +
  case LGLSXP: return LOGICAL(endpoint)[0];
120 +
  default: r_error("pull_endpoint", "`endpoint` must be logical, not %s", Rf_type2char(TYPEOF(endpoint)));
121 +
  }
122 +
}
123 +
124 +
// -----------------------------------------------------------------------------
125 +
126 +
// [[ include("utils.h") ]]
127 +
bool pull_last(SEXP last) {
128 +
  if (Rf_length(last) != 1) {
129 +
    r_error("pull_last", "`last` must have size 1, not %i", Rf_length(last));
130 +
  }
131 +
132 +
  if (OBJECT(last) != 0) {
133 +
    r_error("pull_last", "`last` must be a bare logical value.");
134 +
  }
135 +
136 +
  switch (TYPEOF(last)) {
137 +
  case LGLSXP: return LOGICAL(last)[0];
138 +
  default: r_error("pull_last", "`last` must be logical, not %s", Rf_type2char(TYPEOF(last)));
139 +
  }
140 +
}
141 +
142 +
// -----------------------------------------------------------------------------
143 +
108 144
#define YEARS_FROM_0001_01_01_TO_EPOCH 1969
109 145
#define LEAP_YEARS_FROM_0001_01_01_TO_EPOCH 477
110 146

Everything is accounted for!

No changes detected that need to be reviewed.
What changes does Codecov check for?
Lines, not adjusted in diff, that have changed coverage data.
Files that introduced coverage data that had none before.
Files that have missing coverage data that once were tracked.
Files Coverage
R 66.67%
src -0.25% 94.71%
Project Totals (16 files) 94.27%
Loading