Implement abs() and sign() for duration types (#244)

Author: DavisVaughan

NAMESPACE

@@ -498,6 +498,7 @@ S3method(vec_cast,clock_year_month_day.clock_year_month_day)
 S3method(vec_cast,clock_year_month_weekday.clock_year_month_weekday)
 S3method(vec_cast,clock_year_quarter_day.clock_year_quarter_day)
 S3method(vec_cast,clock_zoned_time.clock_zoned_time)
+S3method(vec_math,clock_duration)
 S3method(vec_math,clock_rcrd)
 S3method(vec_math,clock_weekday)
 S3method(vec_proxy,clock_duration)

NEWS.md

@@ -9,8 +9,8 @@
 * New `invalid_remove()` for removing invalid dates. This is just a wrapper
   around `x[!invalid_detect(x)]`, but works nicely with the pipe (#229).
 
-* All clock types now support `is.nan()`, `is.finite()`, and `is.infinite()`
-  (#235).
+* All clock types now support `is.nan()`, `is.finite()`, and `is.infinite()`.
+  Additionally, duration types now support `abs()` and `sign()` (#235).
 
 # clock 0.3.1
 

R/cpp11.R

@@ -72,6 +72,14 @@ duration_as_double_cpp <- function(fields, precision_int) {
   .Call(`_clock_duration_as_double_cpp`, fields, precision_int)
 }
 
+duration_abs_cpp <- function(fields, precision_int) {
+  .Call(`_clock_duration_abs_cpp`, fields, precision_int)
+}
+
+duration_sign_cpp <- function(fields, precision_int) {
+  .Call(`_clock_duration_sign_cpp`, fields, precision_int)
+}
+
 duration_seq_by_lo_cpp <- function(from, precision_int, by, length_out) {
   .Call(`_clock_duration_seq_by_lo_cpp`, from, precision_int, by, length_out)
 }

R/duration.R

@@ -756,6 +756,31 @@ seq_impl <- function(from, to, by, length.out, along.with, precision, ...) {
 
 # ------------------------------------------------------------------------------
 
+#' @export
+vec_math.clock_duration <- function(.fn, .x, ...) {
+  switch(
+    .fn,
+    abs = duration_abs(.x),
+    sign = duration_sign(.x),
+    # Pass on to `vec_math.clock_rcrd()`
+    NextMethod()
+  )
+}
+
+duration_abs <- function(x) {
+  precision <- duration_precision_attribute(x)
+  fields <- duration_abs_cpp(x, precision)
+  new_duration_from_fields(fields, precision, clock_rcrd_names(x))
+}
+
+duration_sign <- function(x) {
+  out <- duration_sign_cpp(x, duration_precision_attribute(x))
+  names(out) <- names(x)
+  out
+}
+
+# ------------------------------------------------------------------------------
+
 #' @export
 #' @method vec_arith clock_duration
 vec_arith.clock_duration <- function(op, x, y, ...) {

src/cpp11.cpp

@@ -131,6 +131,20 @@ extern "C" SEXP _clock_duration_as_double_cpp(SEXP fields, SEXP precision_int) {
   END_CPP11
 }
 // duration.cpp
+cpp11::writable::list duration_abs_cpp(cpp11::list_of<cpp11::integers> fields, const cpp11::integers& precision_int);
+extern "C" SEXP _clock_duration_abs_cpp(SEXP fields, SEXP precision_int) {
+  BEGIN_CPP11
+    return cpp11::as_sexp(duration_abs_cpp(cpp11::as_cpp<cpp11::decay_t<cpp11::list_of<cpp11::integers>>>(fields), cpp11::as_cpp<cpp11::decay_t<const cpp11::integers&>>(precision_int)));
+  END_CPP11
+}
+// duration.cpp
+cpp11::writable::integers duration_sign_cpp(cpp11::list_of<cpp11::integers> fields, const cpp11::integers& precision_int);
+extern "C" SEXP _clock_duration_sign_cpp(SEXP fields, SEXP precision_int) {
+  BEGIN_CPP11
+    return cpp11::as_sexp(duration_sign_cpp(cpp11::as_cpp<cpp11::decay_t<cpp11::list_of<cpp11::integers>>>(fields), cpp11::as_cpp<cpp11::decay_t<const cpp11::integers&>>(precision_int)));
+  END_CPP11
+}
+// duration.cpp
 cpp11::writable::list duration_seq_by_lo_cpp(cpp11::list_of<cpp11::integers> from, const cpp11::integers& precision_int, cpp11::list_of<cpp11::integers> by, const cpp11::integers& length_out);
 extern "C" SEXP _clock_duration_seq_by_lo_cpp(SEXP from, SEXP precision_int, SEXP by, SEXP length_out) {
   BEGIN_CPP11
@@ -883,6 +897,7 @@ extern SEXP _clock_collect_year_day_fields(SEXP, SEXP);
 extern SEXP _clock_collect_year_month_day_fields(SEXP, SEXP);
 extern SEXP _clock_collect_year_month_weekday_fields(SEXP, SEXP);
 extern SEXP _clock_collect_year_quarter_day_fields(SEXP, SEXP, SEXP);
+extern SEXP _clock_duration_abs_cpp(SEXP, SEXP);
 extern SEXP _clock_duration_as_double_cpp(SEXP, SEXP);
 extern SEXP _clock_duration_as_integer_cpp(SEXP, SEXP);
 extern SEXP _clock_duration_cast_cpp(SEXP, SEXP, SEXP);
@@ -901,6 +916,7 @@ extern SEXP _clock_duration_scalar_multiply_cpp(SEXP, SEXP, SEXP);
 extern SEXP _clock_duration_seq_by_lo_cpp(SEXP, SEXP, SEXP, SEXP);
 extern SEXP _clock_duration_seq_to_by_cpp(SEXP, SEXP, SEXP, SEXP);
 extern SEXP _clock_duration_seq_to_lo_cpp(SEXP, SEXP, SEXP, SEXP);
+extern SEXP _clock_duration_sign_cpp(SEXP, SEXP);
 extern SEXP _clock_duration_unary_minus_cpp(SEXP, SEXP);
 extern SEXP _clock_format_duration_cpp(SEXP, SEXP);
 extern SEXP _clock_format_iso_year_week_day_cpp(SEXP, SEXP);
@@ -1007,6 +1023,7 @@ static const R_CallMethodDef CallEntries[] = {
     {"_clock_collect_year_month_day_fields",                        (DL_FUNC) &_clock_collect_year_month_day_fields,                         2},
     {"_clock_collect_year_month_weekday_fields",                    (DL_FUNC) &_clock_collect_year_month_weekday_fields,                     2},
     {"_clock_collect_year_quarter_day_fields",                      (DL_FUNC) &_clock_collect_year_quarter_day_fields,                       3},
+    {"_clock_duration_abs_cpp",                                     (DL_FUNC) &_clock_duration_abs_cpp,                                      2},
     {"_clock_duration_as_double_cpp",                               (DL_FUNC) &_clock_duration_as_double_cpp,                                2},
     {"_clock_duration_as_integer_cpp",                              (DL_FUNC) &_clock_duration_as_integer_cpp,                               2},
     {"_clock_duration_cast_cpp",                                    (DL_FUNC) &_clock_duration_cast_cpp,                                     3},
@@ -1025,6 +1042,7 @@ static const R_CallMethodDef CallEntries[] = {
     {"_clock_duration_seq_by_lo_cpp",                               (DL_FUNC) &_clock_duration_seq_by_lo_cpp,                                4},
     {"_clock_duration_seq_to_by_cpp",                               (DL_FUNC) &_clock_duration_seq_to_by_cpp,                                4},
     {"_clock_duration_seq_to_lo_cpp",                               (DL_FUNC) &_clock_duration_seq_to_lo_cpp,                                4},
+    {"_clock_duration_sign_cpp",                                    (DL_FUNC) &_clock_duration_sign_cpp,                                     2},
     {"_clock_duration_unary_minus_cpp",                             (DL_FUNC) &_clock_duration_unary_minus_cpp,                              2},
     {"_clock_format_duration_cpp",                                  (DL_FUNC) &_clock_format_duration_cpp,                                   2},
     {"_clock_format_iso_year_week_day_cpp",                         (DL_FUNC) &_clock_format_iso_year_week_day_cpp,                          2},

src/duration.cpp

@@ -1226,6 +1226,152 @@ duration_as_double_cpp(cpp11::list_of<cpp11::integers> fields,
 
 // -----------------------------------------------------------------------------
 
+template <class ClockDuration>
+static
+inline
+cpp11::writable::list
+duration_abs_impl(const ClockDuration& x) {
+  using Duration = typename ClockDuration::duration;
+  using Rep = typename Duration::rep;
+
+  const r_ssize size = x.size();
+  ClockDuration out(size);
+
+  const Rep zero{0};
+
+  for (r_ssize i = 0; i < size; ++i) {
+    if (x.is_na(i)) {
+      out.assign_na(i);
+      continue;
+    }
+
+    const Duration elt = x[i];
+    const Rep elt_rep = elt.count();
+    const Rep out_rep = (elt_rep < zero) ? std::abs(elt_rep) : elt_rep;
+    const Duration out_elt{out_rep};
+
+    out.assign(out_elt, i);
+  }
+
+  return out.to_list();
+}
+
+[[cpp11::register]]
+cpp11::writable::list
+duration_abs_cpp(cpp11::list_of<cpp11::integers> fields,
+                 const cpp11::integers& precision_int) {
+  using namespace rclock;
+
+  cpp11::integers ticks = duration::get_ticks(fields);
+  cpp11::integers ticks_of_day = duration::get_ticks_of_day(fields);
+  cpp11::integers ticks_of_second = duration::get_ticks_of_second(fields);
+
+  duration::years dy{ticks};
+  duration::quarters dq{ticks};
+  duration::months dm{ticks};
+  duration::weeks dw{ticks};
+  duration::days dd{ticks};
+  duration::hours dh{ticks, ticks_of_day};
+  duration::minutes dmin{ticks, ticks_of_day};
+  duration::seconds ds{ticks, ticks_of_day};
+  duration::milliseconds dmilli{ticks, ticks_of_day, ticks_of_second};
+  duration::microseconds dmicro{ticks, ticks_of_day, ticks_of_second};
+  duration::nanoseconds dnano{ticks, ticks_of_day, ticks_of_second};
+
+  switch (parse_precision(precision_int)) {
+  case precision::year: return duration_abs_impl(dy);
+  case precision::quarter: return duration_abs_impl(dq);
+  case precision::month: return duration_abs_impl(dm);
+  case precision::week: return duration_abs_impl(dw);
+  case precision::day: return duration_abs_impl(dd);
+  case precision::hour: return duration_abs_impl(dh);
+  case precision::minute: return duration_abs_impl(dmin);
+  case precision::second: return duration_abs_impl(ds);
+  case precision::millisecond: return duration_abs_impl(dmilli);
+  case precision::microsecond: return duration_abs_impl(dmicro);
+  case precision::nanosecond: return duration_abs_impl(dnano);
+  }
+
+  never_reached("duration_abs_cpp");
+}
+
+// -----------------------------------------------------------------------------
+
+template <class ClockDuration>
+static
+inline
+cpp11::writable::integers
+duration_sign_impl(const ClockDuration& x) {
+  using Duration = typename ClockDuration::duration;
+  using Rep = typename Duration::rep;
+
+  const r_ssize size = x.size();
+  cpp11::writable::integers out(size);
+
+  const Rep zero{0};
+
+  for (r_ssize i = 0; i < size; ++i) {
+    if (x.is_na(i)) {
+      out[i] = r_int_na;
+      continue;
+    }
+
+    const Duration elt = x[i];
+    const Rep elt_rep = elt.count();
+
+    if (elt_rep == zero) {
+      out[i] = 0;
+    } else if (elt_rep > zero) {
+      out[i] = 1;
+    } else {
+      out[i] = -1;
+    }
+  }
+
+  return out;
+}
+
+[[cpp11::register]]
+cpp11::writable::integers
+duration_sign_cpp(cpp11::list_of<cpp11::integers> fields,
+                  const cpp11::integers& precision_int) {
+  using namespace rclock;
+
+  cpp11::integers ticks = duration::get_ticks(fields);
+  cpp11::integers ticks_of_day = duration::get_ticks_of_day(fields);
+  cpp11::integers ticks_of_second = duration::get_ticks_of_second(fields);
+
+  duration::years dy{ticks};
+  duration::quarters dq{ticks};
+  duration::months dm{ticks};
+  duration::weeks dw{ticks};
+  duration::days dd{ticks};
+  duration::hours dh{ticks, ticks_of_day};
+  duration::minutes dmin{ticks, ticks_of_day};
+  duration::seconds ds{ticks, ticks_of_day};
+  duration::milliseconds dmilli{ticks, ticks_of_day, ticks_of_second};
+  duration::microseconds dmicro{ticks, ticks_of_day, ticks_of_second};
+  duration::nanoseconds dnano{ticks, ticks_of_day, ticks_of_second};
+
+  switch (parse_precision(precision_int)) {
+  case precision::year: return duration_sign_impl(dy);
+  case precision::quarter: return duration_sign_impl(dq);
+  case precision::month: return duration_sign_impl(dm);
+  case precision::week: return duration_sign_impl(dw);
+  case precision::day: return duration_sign_impl(dd);
+  case precision::hour: return duration_sign_impl(dh);
+  case precision::minute: return duration_sign_impl(dmin);
+  case precision::second: return duration_sign_impl(ds);
+  case precision::millisecond: return duration_sign_impl(dmilli);
+  case precision::microsecond: return duration_sign_impl(dmicro);
+  case precision::nanosecond: return duration_sign_impl(dnano);
+  }
+
+  never_reached("duration_sign_impl");
+}
+
+// -----------------------------------------------------------------------------
+
 template <class ClockDuration>
 static
 inline

tests/testthat/test-duration.R

@@ -297,3 +297,25 @@ test_that("is.infinite() works", {
   x <- duration_years(c(1, NA))
   expect_identical(is.infinite(x), c(FALSE, FALSE))
 })
+
+test_that("abs() works", {
+  x <- duration_hours(c(-2, -1, 0, 1, 2, NA))
+  expect <- duration_hours(c(2, 1, 0, 1, 2, NA))
+  expect_identical(abs(x), expect)
+})
+
+test_that("abs() propagates names", {
+  x <- set_names(duration_years(1:2), c("a", "b"))
+  expect_named(abs(x), c("a", "b"))
+})
+
+test_that("sign() works", {
+  x <- duration_hours(c(-2, -1, 0, 1, 2, NA))
+  expect <- c(-1L, -1L, 0L, 1L, 1L, NA)
+  expect_identical(sign(x), expect)
+})
+
+test_that("sign() propagates names", {
+  x <- set_names(duration_years(1:2), c("a", "b"))
+  expect_named(sign(x), c("a", "b"))
+})