RcppRoll/0000755000176200001440000000000013305553767012025 5ustar liggesusersRcppRoll/tests/0000755000176200001440000000000013102424373013150 5ustar liggesusersRcppRoll/tests/testthat.R0000644000176200001440000000017213305545771015146 0ustar liggesusersif (requireNamespace("testthat", quietly = TRUE)) { library(testthat) library(RcppRoll) test_check("RcppRoll") } RcppRoll/tests/testthat/0000755000176200001440000000000013305553767015027 5ustar liggesusersRcppRoll/tests/testthat/test-weights.R0000644000176200001440000000034513305246261017567 0ustar liggesuserscontext("Weights") test_that("roll_* do not mutate weights vector", { d <- data.frame(w = c(0.2, 0.1, 0.1, 0.05, 0.05)) roll_sum(1:25, n = length(d$w), weights = d$w) expect_identical(d$w, c(0.2, 0.1, 0.1, 0.05, 0.05)) }) RcppRoll/tests/testthat/test-zoo.R0000644000176200001440000000557013305546036016734 0ustar liggesuserscontext("zoo") test_that("we behave similarly to zoo::rollapply", { if (!requireNamespace("zoo", quietly = TRUE)) skip("zoo not installed") library(testthat) functions <- c("mean", "median", "prod", "min", "max", "sum") x <- rnorm(50) window <- 5L run_tests <- function(data, width, ..., functions, gctorture = FALSE) { for (f in functions) { RcppRoll <- get(paste("roll", f, sep = "_"), envir = asNamespace("RcppRoll")) zoo <- zoo::rollapply(data, width, FUN = get(f), ...) if (is.matrix(zoo)) { dimnames(zoo) <- NULL } if (gctorture) gctorture(TRUE) RcppRollRes <- RcppRoll(data, width, ...) if (gctorture) gctorture(FALSE) expect_equal(RcppRollRes, zoo) } } run_tests(x, window, functions = functions) window <- 50L run_tests(x, window, functions = functions) window <- 1L run_tests(x, window, functions = functions) ## test against small numbers x <- rnorm(1E3) ^ 100 run_tests(x, 5L, functions = functions) ## and large numbers x <- rnorm(1E3, mean = 1E200, sd = 1E201) run_tests(x, 5L, functions = functions) ## now let's really stress it... args <- expand.grid( width = list(3L, 10L, 100L), fill = list(NA, c(-1, 0, 1)), align = list("left", "center", "right"), by = c(1L, 2L, 5L), na.rm = c(TRUE, FALSE) ) # don't use median here f <- setdiff(functions, 'median') data <- rnorm(1E2, 100, 50) for (i in 1:nrow(args)) { run_tests(data, args$width[[i]], fill = args$fill[[i]], align = args$align[[i]], na.rm = args$na.rm[[i]], by = args$by[[i]], functions = f) } data[sample(length(data), length(data) / 3)] <- NA for (i in 1:nrow(args)) { suppressWarnings(run_tests(data, args$width[[i]], fill = args$fill[[i]], align = args$align[[i]], na.rm = args$na.rm[[i]], by = args$by[[i]], functions = f)) } data <- matrix(rnorm(2E2, 100, 50), nrow = 100) for (i in 1:nrow(args)) { run_tests( data, args$width[[i]], fill = args$fill[[i]], align = args$align[[i]], by = args$by[[i]], functions = functions ) } }) test_that("we don't segfault when window size > vector size on ops with fill", { x <- c(1:5) w <- 10 gctorture(TRUE) result <- roll_meanr(x, w) gctorture(FALSE) expect_identical( roll_meanr(x, w), rep(NA_real_, length(x)) ) }) test_that("we handle an empty fill properly", { if (!requireNamespace("zoo", quietly = TRUE)) skip("zoo not installed") for (i in 10:100) { data <- 1:i lhs <- zoo::rollapply(data, 3, mean, by = 3) rhs <- roll_mean(data, 3, by = 3, fill = numeric()) expect_identical(lhs, rhs) } }) RcppRoll/src/0000755000176200001440000000000013305546064012604 5ustar liggesusersRcppRoll/src/RcppExports.cpp0000644000176200001440000002512113305546064015602 0ustar liggesusers// Generated by using Rcpp::compileAttributes() -> do not edit by hand // Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393 #include using namespace Rcpp; // na_locf NumericVector na_locf(NumericVector x); RcppExport SEXP _RcppRoll_na_locf(SEXP xSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< NumericVector >::type x(xSEXP); rcpp_result_gen = Rcpp::wrap(na_locf(x)); return rcpp_result_gen; END_RCPP } // roll_mean_impl SEXP roll_mean_impl(SEXP x, int n, NumericVector weights, int by, NumericVector fill_, bool partial, String align, bool normalize, bool na_rm); RcppExport SEXP _RcppRoll_roll_mean_impl(SEXP xSEXP, SEXP nSEXP, SEXP weightsSEXP, SEXP bySEXP, SEXP fill_SEXP, SEXP partialSEXP, SEXP alignSEXP, SEXP normalizeSEXP, SEXP na_rmSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< SEXP >::type x(xSEXP); Rcpp::traits::input_parameter< int >::type n(nSEXP); Rcpp::traits::input_parameter< NumericVector >::type weights(weightsSEXP); Rcpp::traits::input_parameter< int >::type by(bySEXP); Rcpp::traits::input_parameter< NumericVector >::type fill_(fill_SEXP); Rcpp::traits::input_parameter< bool >::type partial(partialSEXP); Rcpp::traits::input_parameter< String >::type align(alignSEXP); Rcpp::traits::input_parameter< bool >::type normalize(normalizeSEXP); Rcpp::traits::input_parameter< bool >::type na_rm(na_rmSEXP); rcpp_result_gen = Rcpp::wrap(roll_mean_impl(x, n, weights, by, fill_, partial, align, normalize, na_rm)); return rcpp_result_gen; END_RCPP } // roll_median_impl SEXP roll_median_impl(SEXP x, int n, NumericVector weights, int by, NumericVector fill_, bool partial, String align, bool normalize, bool na_rm); RcppExport SEXP _RcppRoll_roll_median_impl(SEXP xSEXP, SEXP nSEXP, SEXP weightsSEXP, SEXP bySEXP, SEXP fill_SEXP, SEXP partialSEXP, SEXP alignSEXP, SEXP normalizeSEXP, SEXP na_rmSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< SEXP >::type x(xSEXP); Rcpp::traits::input_parameter< int >::type n(nSEXP); Rcpp::traits::input_parameter< NumericVector >::type weights(weightsSEXP); Rcpp::traits::input_parameter< int >::type by(bySEXP); Rcpp::traits::input_parameter< NumericVector >::type fill_(fill_SEXP); Rcpp::traits::input_parameter< bool >::type partial(partialSEXP); Rcpp::traits::input_parameter< String >::type align(alignSEXP); Rcpp::traits::input_parameter< bool >::type normalize(normalizeSEXP); Rcpp::traits::input_parameter< bool >::type na_rm(na_rmSEXP); rcpp_result_gen = Rcpp::wrap(roll_median_impl(x, n, weights, by, fill_, partial, align, normalize, na_rm)); return rcpp_result_gen; END_RCPP } // roll_min_impl SEXP roll_min_impl(SEXP x, int n, NumericVector weights, int by, NumericVector fill_, bool partial, String align, bool normalize, bool na_rm); RcppExport SEXP _RcppRoll_roll_min_impl(SEXP xSEXP, SEXP nSEXP, SEXP weightsSEXP, SEXP bySEXP, SEXP fill_SEXP, SEXP partialSEXP, SEXP alignSEXP, SEXP normalizeSEXP, SEXP na_rmSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< SEXP >::type x(xSEXP); Rcpp::traits::input_parameter< int >::type n(nSEXP); Rcpp::traits::input_parameter< NumericVector >::type weights(weightsSEXP); Rcpp::traits::input_parameter< int >::type by(bySEXP); Rcpp::traits::input_parameter< NumericVector >::type fill_(fill_SEXP); Rcpp::traits::input_parameter< bool >::type partial(partialSEXP); Rcpp::traits::input_parameter< String >::type align(alignSEXP); Rcpp::traits::input_parameter< bool >::type normalize(normalizeSEXP); Rcpp::traits::input_parameter< bool >::type na_rm(na_rmSEXP); rcpp_result_gen = Rcpp::wrap(roll_min_impl(x, n, weights, by, fill_, partial, align, normalize, na_rm)); return rcpp_result_gen; END_RCPP } // roll_max_impl SEXP roll_max_impl(SEXP x, int n, NumericVector weights, int by, NumericVector fill_, bool partial, String align, bool normalize, bool na_rm); RcppExport SEXP _RcppRoll_roll_max_impl(SEXP xSEXP, SEXP nSEXP, SEXP weightsSEXP, SEXP bySEXP, SEXP fill_SEXP, SEXP partialSEXP, SEXP alignSEXP, SEXP normalizeSEXP, SEXP na_rmSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< SEXP >::type x(xSEXP); Rcpp::traits::input_parameter< int >::type n(nSEXP); Rcpp::traits::input_parameter< NumericVector >::type weights(weightsSEXP); Rcpp::traits::input_parameter< int >::type by(bySEXP); Rcpp::traits::input_parameter< NumericVector >::type fill_(fill_SEXP); Rcpp::traits::input_parameter< bool >::type partial(partialSEXP); Rcpp::traits::input_parameter< String >::type align(alignSEXP); Rcpp::traits::input_parameter< bool >::type normalize(normalizeSEXP); Rcpp::traits::input_parameter< bool >::type na_rm(na_rmSEXP); rcpp_result_gen = Rcpp::wrap(roll_max_impl(x, n, weights, by, fill_, partial, align, normalize, na_rm)); return rcpp_result_gen; END_RCPP } // roll_prod_impl SEXP roll_prod_impl(SEXP x, int n, NumericVector weights, int by, NumericVector fill_, bool partial, String align, bool normalize, bool na_rm); RcppExport SEXP _RcppRoll_roll_prod_impl(SEXP xSEXP, SEXP nSEXP, SEXP weightsSEXP, SEXP bySEXP, SEXP fill_SEXP, SEXP partialSEXP, SEXP alignSEXP, SEXP normalizeSEXP, SEXP na_rmSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< SEXP >::type x(xSEXP); Rcpp::traits::input_parameter< int >::type n(nSEXP); Rcpp::traits::input_parameter< NumericVector >::type weights(weightsSEXP); Rcpp::traits::input_parameter< int >::type by(bySEXP); Rcpp::traits::input_parameter< NumericVector >::type fill_(fill_SEXP); Rcpp::traits::input_parameter< bool >::type partial(partialSEXP); Rcpp::traits::input_parameter< String >::type align(alignSEXP); Rcpp::traits::input_parameter< bool >::type normalize(normalizeSEXP); Rcpp::traits::input_parameter< bool >::type na_rm(na_rmSEXP); rcpp_result_gen = Rcpp::wrap(roll_prod_impl(x, n, weights, by, fill_, partial, align, normalize, na_rm)); return rcpp_result_gen; END_RCPP } // roll_sum_impl SEXP roll_sum_impl(SEXP x, int n, NumericVector weights, int by, NumericVector fill_, bool partial, String align, bool normalize, bool na_rm); RcppExport SEXP _RcppRoll_roll_sum_impl(SEXP xSEXP, SEXP nSEXP, SEXP weightsSEXP, SEXP bySEXP, SEXP fill_SEXP, SEXP partialSEXP, SEXP alignSEXP, SEXP normalizeSEXP, SEXP na_rmSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< SEXP >::type x(xSEXP); Rcpp::traits::input_parameter< int >::type n(nSEXP); Rcpp::traits::input_parameter< NumericVector >::type weights(weightsSEXP); Rcpp::traits::input_parameter< int >::type by(bySEXP); Rcpp::traits::input_parameter< NumericVector >::type fill_(fill_SEXP); Rcpp::traits::input_parameter< bool >::type partial(partialSEXP); Rcpp::traits::input_parameter< String >::type align(alignSEXP); Rcpp::traits::input_parameter< bool >::type normalize(normalizeSEXP); Rcpp::traits::input_parameter< bool >::type na_rm(na_rmSEXP); rcpp_result_gen = Rcpp::wrap(roll_sum_impl(x, n, weights, by, fill_, partial, align, normalize, na_rm)); return rcpp_result_gen; END_RCPP } // roll_sd_impl SEXP roll_sd_impl(SEXP x, int n, NumericVector weights, int by, NumericVector fill_, bool partial, String align, bool normalize, bool na_rm); RcppExport SEXP _RcppRoll_roll_sd_impl(SEXP xSEXP, SEXP nSEXP, SEXP weightsSEXP, SEXP bySEXP, SEXP fill_SEXP, SEXP partialSEXP, SEXP alignSEXP, SEXP normalizeSEXP, SEXP na_rmSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< SEXP >::type x(xSEXP); Rcpp::traits::input_parameter< int >::type n(nSEXP); Rcpp::traits::input_parameter< NumericVector >::type weights(weightsSEXP); Rcpp::traits::input_parameter< int >::type by(bySEXP); Rcpp::traits::input_parameter< NumericVector >::type fill_(fill_SEXP); Rcpp::traits::input_parameter< bool >::type partial(partialSEXP); Rcpp::traits::input_parameter< String >::type align(alignSEXP); Rcpp::traits::input_parameter< bool >::type normalize(normalizeSEXP); Rcpp::traits::input_parameter< bool >::type na_rm(na_rmSEXP); rcpp_result_gen = Rcpp::wrap(roll_sd_impl(x, n, weights, by, fill_, partial, align, normalize, na_rm)); return rcpp_result_gen; END_RCPP } // roll_var_impl SEXP roll_var_impl(SEXP x, int n, NumericVector weights, int by, NumericVector fill_, bool partial, String align, bool normalize, bool na_rm); RcppExport SEXP _RcppRoll_roll_var_impl(SEXP xSEXP, SEXP nSEXP, SEXP weightsSEXP, SEXP bySEXP, SEXP fill_SEXP, SEXP partialSEXP, SEXP alignSEXP, SEXP normalizeSEXP, SEXP na_rmSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< SEXP >::type x(xSEXP); Rcpp::traits::input_parameter< int >::type n(nSEXP); Rcpp::traits::input_parameter< NumericVector >::type weights(weightsSEXP); Rcpp::traits::input_parameter< int >::type by(bySEXP); Rcpp::traits::input_parameter< NumericVector >::type fill_(fill_SEXP); Rcpp::traits::input_parameter< bool >::type partial(partialSEXP); Rcpp::traits::input_parameter< String >::type align(alignSEXP); Rcpp::traits::input_parameter< bool >::type normalize(normalizeSEXP); Rcpp::traits::input_parameter< bool >::type na_rm(na_rmSEXP); rcpp_result_gen = Rcpp::wrap(roll_var_impl(x, n, weights, by, fill_, partial, align, normalize, na_rm)); return rcpp_result_gen; END_RCPP } static const R_CallMethodDef CallEntries[] = { {"_RcppRoll_na_locf", (DL_FUNC) &_RcppRoll_na_locf, 1}, {"_RcppRoll_roll_mean_impl", (DL_FUNC) &_RcppRoll_roll_mean_impl, 9}, {"_RcppRoll_roll_median_impl", (DL_FUNC) &_RcppRoll_roll_median_impl, 9}, {"_RcppRoll_roll_min_impl", (DL_FUNC) &_RcppRoll_roll_min_impl, 9}, {"_RcppRoll_roll_max_impl", (DL_FUNC) &_RcppRoll_roll_max_impl, 9}, {"_RcppRoll_roll_prod_impl", (DL_FUNC) &_RcppRoll_roll_prod_impl, 9}, {"_RcppRoll_roll_sum_impl", (DL_FUNC) &_RcppRoll_roll_sum_impl, 9}, {"_RcppRoll_roll_sd_impl", (DL_FUNC) &_RcppRoll_roll_sd_impl, 9}, {"_RcppRoll_roll_var_impl", (DL_FUNC) &_RcppRoll_roll_var_impl, 9}, {NULL, NULL, 0} }; RcppExport void R_init_RcppRoll(DllInfo *dll) { R_registerRoutines(dll, NULL, CallEntries, NULL, NULL); R_useDynamicSymbols(dll, FALSE); } RcppRoll/src/RcppRoll.cpp0000644000176200001440000005763713305546064015067 0ustar liggesusers#define DEBUG(x) x #include using namespace Rcpp; namespace RcppRoll { class Fill { public: Fill (NumericVector const& vector) { switch (Rf_length(vector)) { case 0: { filled_ = false; break; } case 1: { left_ = middle_ = right_ = vector[0]; filled_ = true; break; } case 3: { left_ = vector[0]; middle_ = vector[1]; right_ = vector[2]; filled_ = true; break; } default: { stop("'fill' should be a vector of size 0, 1, or 3"); } } } Fill (Fill const& other): left_(other.left_), middle_(other.middle_), right_(other.right_), filled_(other.filled_) {} inline double left() const { return left_; } inline double middle() const { return middle_; } inline double right() const { return right_; } inline bool filled() const { return filled_; } private: double left_; double middle_; double right_; bool filled_; }; template struct product { inline T operator()(T const& left, T const& right) { return left * right; } }; template inline double prod(T const& x) { return std::accumulate(x.begin(), x.end(), 1.0, product()); } inline int getLeftPadding(Fill const& fill, String const& align, int n) { if (!fill.filled()) return 0; if (align == "left") { return 0; } else if (align == "center") { return (n - 1) / 2; // round down } else if (align == "right") { return n - 1; } else { stop("Invalid 'align'"); } return -1; // silence compiler } inline int getRightPadding(Fill const& fill, String const& align, int n) { if (!fill.filled()) return 0; if (align == "left") { return n - 1; } else if (align == "center") { return n / 2; } else if (align == "right") { return 0; } else { stop("Invalid 'align'"); } return -1; // silence compiler } template T roll_vector_with(Callable f, T const& x, int n, NumericVector& weights, int by, Fill const& fill, bool partial, String const& align, bool normalize) { // Normalize 'n' to match that of weights if (weights.size()) n = weights.size(); if (normalize && weights.size()) weights = Rcpp::clone(NumericVector(weights / sum(weights) * n)); return fill.filled() ? roll_vector_with_fill(f, x, n, weights, by, fill, partial, align) : roll_vector_with_nofill(f, x, n, weights, by, fill, partial, align) ; } template T roll_vector_with_fill(Callable f, T const& x, int n, NumericVector& weights, int by, Fill const& fill, bool partial, String const& align) { if (x.size() < n) return rep(T::get_na(), x.size()); // figure out if we need to pad at the start, end, etc. int padLeftTimes = getLeftPadding(fill, align, n); int padRightTimes = getRightPadding(fill, align, n); int x_n = x.size(); int ops_n = x_n - n + 1; int output_n = padLeftTimes + ops_n + padRightTimes; T result; int i = 0; if (by == 1) { result = static_cast(no_init(output_n)); } else { result = T(output_n, fill.middle()); } // Pad left for (; i < padLeftTimes; ++i) result[i] = fill.left(); // Fill result -- we hoist the indexing variable outside of the loop // so we can re-use it to easily figure out where our 'fill-right' // pass-through should start if (weights.size()) { for (; i < padLeftTimes + ops_n; i += by) { result[i] = f(x, i - padLeftTimes, weights, n); } } else { for (; i < padLeftTimes + ops_n; i += by) { result[i] = f(x, i - padLeftTimes, n); } } // Fill-right on the remainders. We move the index // back one 'by' iteration, then move it back one. i -= by; ++i; for (; i < output_n; ++i) result[i] = fill.right(); return result; } template T roll_vector_with_nofill(Callable f, T const& x, int n, NumericVector& weights, int by, Fill const& fill, bool partial, String const& align) { int x_n = x.size(); int output_n = (x_n - n) / by + 1; T result = static_cast(no_init(output_n)); int index = 0; if (weights.size()) { for (int i = 0; i < output_n; ++i) { result[i] = f(x, index, weights, n); index += by; } } else { for (int i = 0; i < output_n; ++i) { result[i] = f(x, index, n); index += by; } } return result; } template T roll_matrix_with(Callable f, T const& x, int n, NumericVector& weights, int by, Fill const& fill, bool partial, String const& align, bool normalize) { int nrow = x.nrow(); int ncol = x.ncol(); T output; if (fill.filled()) { output = T(nrow, ncol); } else { output = T(nrow - n + 1, ncol); } for (int i = 0; i < ncol; ++i) { output(_, i) = roll_vector_with( f, static_cast(x(_, i)), n, weights, by, fill, partial, align, normalize); } return output; } template struct mean_f; template <> struct mean_f { inline double operator()(NumericVector const& x, int offset, int n) { double result = 0.0; int num = 0; for (int i = 0; i < n; ++i) { if (!ISNAN(x[offset + i])) { result += x[offset + i]; ++num; } } return result / num; } inline double operator()(NumericVector const& x, int offset, NumericVector& weights, int n) { double result = 0.0; int num = 0; for (int i = 0; i < n; ++i) { if (!ISNAN(x[offset + i])) { result += x[offset + i] * weights[i]; ++num; } } return result / num; } }; template <> struct mean_f { inline double operator()(NumericVector const& x, int offset, int n) { double result = 0.0; for (int i = 0; i < n; ++i) { result += x[offset + i]; } return result / n; } inline double operator()(NumericVector const& x, int offset, NumericVector& weights, int n) { double result = 0.0; for (int i = 0; i < n; ++i) { result += x[offset + i] * weights[i]; } return result / n; } }; template struct sum_f; template <> struct sum_f { inline double operator()(NumericVector const& x, int offset, int n) { double result = 0.0; for (int i = 0; i < n; ++i) { result += x[offset + i]; } return result; } inline double operator()(NumericVector const& x, int offset, NumericVector& weights, int n) { double result = 0.0; for (int i = 0; i < n; ++i) { result += x[offset + i] * weights[i]; } return result; } }; template <> struct sum_f { inline double operator()(NumericVector const& x, int offset, int n) { double result = 0.0; for (int i = 0; i < n; ++i) { if (!ISNAN(x[offset + i])) { result += x[offset + i]; } } return result; } inline double operator()(NumericVector const& x, int offset, NumericVector& weights, int n) { double result = 0.0; for (int i = 0; i < n; ++i) { if (!ISNAN(x[offset + i])) { result += x[offset + i] * weights[i]; } } return result; } }; template struct min_f; template <> struct min_f { inline double operator()(NumericVector const& x, int offset, int n) { double result = R_PosInf; for (int i = 0; i < n; ++i) { if (ISNAN(x[offset + i])) { return NA_REAL; } result = x[offset + i] < result ? x[offset + i] : result; } return result; } inline double operator()(NumericVector const& x, int offset, NumericVector& weights, int n) { double result = R_PosInf; for (int i = 0; i < n; ++i) { if (ISNAN(x[offset + i])) { return NA_REAL; } #define VALUE (x[offset + i] * weights[i]) result = VALUE < result ? VALUE : result; #undef VALUE } return result; } }; template <> struct min_f { inline double operator()(NumericVector const& x, int offset, NumericVector& weights, int n) { double result = R_PosInf; for (int i = 0; i < n; ++i) { #define VALUE (x[offset + i] * weights[i]) result = VALUE < result ? VALUE : result; #undef VALUE } return result; } inline double operator()(NumericVector const& x, int offset, int n) { double result = R_PosInf; for (int i = 0; i < n; ++i) { result = x[offset + i] < result ? x[offset + i] : result; } return result; } }; template struct max_f; template <> struct max_f { inline double operator()(NumericVector const& x, int offset, NumericVector& weights, int n) { double result = R_NegInf; for (int i = 0; i < n; ++i) { if (ISNAN(x[offset + i])) { return NA_REAL; } #define VALUE (x[offset + i] * weights[i]) result = VALUE < result ? result : VALUE; #undef VALUE } return result; } inline double operator()(NumericVector const& x, int offset, int n) { double result = R_NegInf; for (int i = 0; i < n; ++i) { if (ISNAN(x[offset + i])) { return NA_REAL; } result = x[offset + i] < result ? result : x[offset + i]; } return result; } }; template <> struct max_f { inline double operator()(NumericVector const& x, int offset, NumericVector& weights, int n) { double result = R_NegInf; for (int i = 0; i < n; ++i) { if (ISNAN(x[offset + i])) continue; #define VALUE (x[offset + i] * weights[i]) result = VALUE < result ? result : VALUE; #undef VALUE } return result; } inline double operator()(NumericVector const& x, int offset, int n) { double result = R_NegInf; for (int i = 0; i < n; ++i) { if (ISNAN(x[offset + i])) continue; result = x[offset + i] < result ? result : x[offset + i]; } return result; } }; template struct prod_f; template <> struct prod_f { inline double operator()(NumericVector const& x, int offset, int n) { double result = 1.0; for (int i = 0; i < n; ++i) { if (!ISNAN(x[offset + i])) { result *= x[offset + i]; } } return result; } inline double operator()(NumericVector const& x, int offset, NumericVector& weights, int n) { double result = 1.0; for (int i = 0; i < n; ++i) { if (!ISNAN(x[offset + i])) { result *= x[offset + i] * weights[i]; } } return result; } }; template <> struct prod_f { inline double operator()(NumericVector const& x, int offset, int n) { double result = 1.0; for (int i = 0; i < n; ++i) { result *= x[offset + i]; } return result; } inline double operator()(NumericVector const& x, int offset, NumericVector& weights, int n) { double result = 1.0; for (int i = 0; i < n; ++i) { result *= x[offset + i] * weights[i]; } return result; } }; template struct median_f; template <> struct median_f { inline double operator()(NumericVector const& x, int offset, int n) { std::vector copied(n / 2 + 1); std::partial_sort_copy( x.begin() + offset, x.begin() + offset + n, copied.begin(), copied.begin() + n / 2 + 1 ); if (n % 2 == 0) { return (copied[n / 2 - 1] + copied[n / 2]) / 2; } else { return copied[n / 2]; } } inline double operator()(NumericVector const& x, int offset, NumericVector& weights, int n) { NumericVector copy(x.begin() + offset, x.begin() + offset + n); std::sort(copy.begin(), copy.end()); double weights_sum = sum(weights); int k = 0; double sum = weights_sum - weights[0]; while (sum > weights_sum / 2) { ++k; sum -= weights[k]; } return copy[k]; } }; template <> struct median_f { inline double operator()(NumericVector const& x, int offset, int n) { std::vector copied(n / 2 + 1); std::partial_sort_copy( x.begin() + offset, x.begin() + offset + n, copied.begin(), copied.begin() + n / 2 + 1 ); if (n % 2 == 0) { return (copied[n / 2 - 1] + copied[n / 2]) / 2; } else { return copied[n / 2]; } } inline double operator()(NumericVector const& x, int offset, NumericVector& weights, int n) { NumericVector copy(x.begin() + offset, x.begin() + offset + n); std::sort(copy.begin(), copy.end()); double weights_sum = sum(weights); int k = 0; double sum = weights_sum - weights[0]; while (sum > weights_sum / 2) { ++k; sum -= weights[k]; } return copy[k]; } }; template struct var_f; template <> struct var_f { inline double operator()(NumericVector const& x, int offset, int n) { return var(NumericVector(x.begin() + offset, x.begin() + offset + n)); } inline double operator()(NumericVector const& x, int offset, NumericVector weights, int n) { NumericVector sub(x.begin() + offset, x.begin() + offset + n); return var(sub * weights); } }; template <> struct var_f { inline double operator()(NumericVector const& x, int offset, int n) { NumericVector sub(x.begin() + offset, x.begin() + offset + n); sub = na_omit(sub); return var(sub); } inline double operator()(NumericVector const& x, int offset, NumericVector weights, int n) { NumericVector sub(x.begin() + offset, x.begin() + offset + n); sub = na_omit(sub); return var(sub * weights); } }; template struct sd_f; template <> struct sd_f { inline double operator()(NumericVector const& x, int offset, int n) { return sqrt(var(NumericVector(x.begin() + offset, x.begin() + offset + n))); } inline double operator()(NumericVector const& x, int offset, NumericVector weights, int n) { NumericVector sub(x.begin() + offset, x.begin() + offset + n); return sqrt(var(sub * weights)); } }; template <> struct sd_f { inline double operator()(NumericVector const& x, int offset, int n) { NumericVector sub(x.begin() + offset, x.begin() + offset + n); sub = na_omit(sub); return sqrt(var(sub)); } inline double operator()(NumericVector const& x, int offset, NumericVector weights, int n) { NumericVector sub(x.begin() + offset, x.begin() + offset + n); sub = na_omit(sub); return sqrt(var(sub * weights)); } }; } // end namespace RcppRoll // [[Rcpp::export]] NumericVector na_locf(NumericVector x) { NumericVector output = Rcpp::clone(x); double lastNonNA = NA_REAL; int n = x.size(); for (int i = 0; i < n; ++i) { double value = output[i]; if (!ISNAN(value)) lastNonNA = value; else output[i] = lastNonNA; } return output; } // Begin auto-generated exports (internal/make-exports.R) // [[Rcpp::export]] SEXP roll_mean_impl(SEXP x, int n, NumericVector weights, int by, NumericVector fill_, bool partial, String align, bool normalize, bool na_rm) { RcppRoll::Fill fill(fill_); if (Rf_isMatrix(x)) { if (na_rm) { return RcppRoll::roll_matrix_with( RcppRoll::mean_f(), NumericMatrix(x), n, weights, by, fill, partial, align, normalize); } else { return RcppRoll::roll_matrix_with( RcppRoll::mean_f(), NumericMatrix(x), n, weights, by, fill, partial, align, normalize); } } else { if (na_rm) { return RcppRoll::roll_vector_with( RcppRoll::mean_f(), NumericVector(x), n, weights, by, fill, partial, align, normalize); } else { return RcppRoll::roll_vector_with( RcppRoll::mean_f(), NumericVector(x), n, weights, by, fill, partial, align, normalize); } } } // [[Rcpp::export]] SEXP roll_median_impl(SEXP x, int n, NumericVector weights, int by, NumericVector fill_, bool partial, String align, bool normalize, bool na_rm) { RcppRoll::Fill fill(fill_); if (Rf_isMatrix(x)) { if (na_rm) { return RcppRoll::roll_matrix_with( RcppRoll::median_f(), NumericMatrix(x), n, weights, by, fill, partial, align, normalize); } else { return RcppRoll::roll_matrix_with( RcppRoll::median_f(), NumericMatrix(x), n, weights, by, fill, partial, align, normalize); } } else { if (na_rm) { return RcppRoll::roll_vector_with( RcppRoll::median_f(), NumericVector(x), n, weights, by, fill, partial, align, normalize); } else { return RcppRoll::roll_vector_with( RcppRoll::median_f(), NumericVector(x), n, weights, by, fill, partial, align, normalize); } } } // [[Rcpp::export]] SEXP roll_min_impl(SEXP x, int n, NumericVector weights, int by, NumericVector fill_, bool partial, String align, bool normalize, bool na_rm) { RcppRoll::Fill fill(fill_); if (Rf_isMatrix(x)) { if (na_rm) { return RcppRoll::roll_matrix_with( RcppRoll::min_f(), NumericMatrix(x), n, weights, by, fill, partial, align, normalize); } else { return RcppRoll::roll_matrix_with( RcppRoll::min_f(), NumericMatrix(x), n, weights, by, fill, partial, align, normalize); } } else { if (na_rm) { return RcppRoll::roll_vector_with( RcppRoll::min_f(), NumericVector(x), n, weights, by, fill, partial, align, normalize); } else { return RcppRoll::roll_vector_with( RcppRoll::min_f(), NumericVector(x), n, weights, by, fill, partial, align, normalize); } } } // [[Rcpp::export]] SEXP roll_max_impl(SEXP x, int n, NumericVector weights, int by, NumericVector fill_, bool partial, String align, bool normalize, bool na_rm) { RcppRoll::Fill fill(fill_); if (Rf_isMatrix(x)) { if (na_rm) { return RcppRoll::roll_matrix_with( RcppRoll::max_f(), NumericMatrix(x), n, weights, by, fill, partial, align, normalize); } else { return RcppRoll::roll_matrix_with( RcppRoll::max_f(), NumericMatrix(x), n, weights, by, fill, partial, align, normalize); } } else { if (na_rm) { return RcppRoll::roll_vector_with( RcppRoll::max_f(), NumericVector(x), n, weights, by, fill, partial, align, normalize); } else { return RcppRoll::roll_vector_with( RcppRoll::max_f(), NumericVector(x), n, weights, by, fill, partial, align, normalize); } } } // [[Rcpp::export]] SEXP roll_prod_impl(SEXP x, int n, NumericVector weights, int by, NumericVector fill_, bool partial, String align, bool normalize, bool na_rm) { RcppRoll::Fill fill(fill_); if (Rf_isMatrix(x)) { if (na_rm) { return RcppRoll::roll_matrix_with( RcppRoll::prod_f(), NumericMatrix(x), n, weights, by, fill, partial, align, normalize); } else { return RcppRoll::roll_matrix_with( RcppRoll::prod_f(), NumericMatrix(x), n, weights, by, fill, partial, align, normalize); } } else { if (na_rm) { return RcppRoll::roll_vector_with( RcppRoll::prod_f(), NumericVector(x), n, weights, by, fill, partial, align, normalize); } else { return RcppRoll::roll_vector_with( RcppRoll::prod_f(), NumericVector(x), n, weights, by, fill, partial, align, normalize); } } } // [[Rcpp::export]] SEXP roll_sum_impl(SEXP x, int n, NumericVector weights, int by, NumericVector fill_, bool partial, String align, bool normalize, bool na_rm) { RcppRoll::Fill fill(fill_); if (Rf_isMatrix(x)) { if (na_rm) { return RcppRoll::roll_matrix_with( RcppRoll::sum_f(), NumericMatrix(x), n, weights, by, fill, partial, align, normalize); } else { return RcppRoll::roll_matrix_with( RcppRoll::sum_f(), NumericMatrix(x), n, weights, by, fill, partial, align, normalize); } } else { if (na_rm) { return RcppRoll::roll_vector_with( RcppRoll::sum_f(), NumericVector(x), n, weights, by, fill, partial, align, normalize); } else { return RcppRoll::roll_vector_with( RcppRoll::sum_f(), NumericVector(x), n, weights, by, fill, partial, align, normalize); } } } // [[Rcpp::export]] SEXP roll_sd_impl(SEXP x, int n, NumericVector weights, int by, NumericVector fill_, bool partial, String align, bool normalize, bool na_rm) { RcppRoll::Fill fill(fill_); if (Rf_isMatrix(x)) { if (na_rm) { return RcppRoll::roll_matrix_with( RcppRoll::sd_f(), NumericMatrix(x), n, weights, by, fill, partial, align, normalize); } else { return RcppRoll::roll_matrix_with( RcppRoll::sd_f(), NumericMatrix(x), n, weights, by, fill, partial, align, normalize); } } else { if (na_rm) { return RcppRoll::roll_vector_with( RcppRoll::sd_f(), NumericVector(x), n, weights, by, fill, partial, align, normalize); } else { return RcppRoll::roll_vector_with( RcppRoll::sd_f(), NumericVector(x), n, weights, by, fill, partial, align, normalize); } } } // [[Rcpp::export]] SEXP roll_var_impl(SEXP x, int n, NumericVector weights, int by, NumericVector fill_, bool partial, String align, bool normalize, bool na_rm) { RcppRoll::Fill fill(fill_); if (Rf_isMatrix(x)) { if (na_rm) { return RcppRoll::roll_matrix_with( RcppRoll::var_f(), NumericMatrix(x), n, weights, by, fill, partial, align, normalize); } else { return RcppRoll::roll_matrix_with( RcppRoll::var_f(), NumericMatrix(x), n, weights, by, fill, partial, align, normalize); } } else { if (na_rm) { return RcppRoll::roll_vector_with( RcppRoll::var_f(), NumericVector(x), n, weights, by, fill, partial, align, normalize); } else { return RcppRoll::roll_vector_with( RcppRoll::var_f(), NumericVector(x), n, weights, by, fill, partial, align, normalize); } } } // End auto-generated exports (internal/make-exports.R) RcppRoll/NAMESPACE0000644000176200001440000000104513305254660013232 0ustar liggesusers# Generated by roxygen2: do not edit by hand export(roll_max) export(roll_maxl) export(roll_maxr) export(roll_mean) export(roll_meanl) export(roll_meanr) export(roll_median) export(roll_medianl) export(roll_medianr) export(roll_min) export(roll_minl) export(roll_minr) export(roll_prod) export(roll_prodl) export(roll_prodr) export(roll_sd) export(roll_sdl) export(roll_sdr) export(roll_sum) export(roll_suml) export(roll_sumr) export(roll_var) export(roll_varl) export(roll_varr) importFrom(Rcpp,evalCpp) useDynLib(RcppRoll, .registration = TRUE) RcppRoll/NEWS.md0000644000176200001440000000104313305254354013107 0ustar liggesusers# RcppRoll 0.3.0 - Properly document the `align` argument -- the function accepts "center" rather than "middle". (#28) - Fixed an issue where empty fills were not handled correctly. - The interface has now been standardized such that each implemented window function has version center-aligned by default (e.g. `roll_mean()`), a left-aligned version (`roll_meanl()`), and right-aligned version (`roll_meanr()`). - Implement rolling window functions for `mean()`, `median()`, `min()`, `max()`, `prod()`, `sum()`, `sd()` and `var()`. RcppRoll/R/0000755000176200001440000000000013102424373012207 5ustar liggesusersRcppRoll/R/RcppRoll.R0000644000176200001440000004700113305253110014063 0ustar liggesusers# Auto-generated by internal/make-exports.R #' RcppRoll #' #' Efficient windowed / rolling operations. Each function #' here applies an operation over a moving window of #' size \code{n}, with (customizable) weights specified #' through \code{weights}. #' #' The functions postfixed with \code{l} and \code{r} #' are convenience wrappers that set \strong{l}eft #' / \strong{r}ight alignment of the windowed operations. #' #' @name RcppRoll-exports #' @param x A numeric vector or a numeric matrix. #' @param n The window size. Ignored when \code{weights} is non-\code{NULL}. #' @param weights A vector of length \code{n}, giving the weights for each #' element within a window. If \code{NULL}, we take unit weights of width \code{n}. #' @param by Calculate at every \code{by}-th point rather than every point. #' @param fill Either an empty vector (no fill), or a vector (recycled to) #' length 3 giving left, middle and right fills. #' @param partial Partial application? Currently unimplemented. #' @param align Align windows on the \code{"left"}, \code{"center"} or #' \code{"right"}. #' @param normalize Normalize window weights, such that they sum to \code{n}. #' @param na.rm Remove missing values? NULL #' @rdname RcppRoll-exports #' @export roll_mean <- function(x, n = 1L, weights = NULL, by = 1L, fill = numeric(0), partial = FALSE, align = c("center", "left", "right"), normalize = TRUE, na.rm = FALSE) { if (!identical(partial, FALSE)) { warning("'partial' argument is currently unimplemented; using 'partial = FALSE'") partial <- FALSE } result <- roll_mean_impl( x, as.integer(n), as.numeric(weights), as.integer(by), as.numeric(fill), as.logical(partial), as.character(match.arg(align)), as.logical(normalize), as.logical(na.rm) ) colnames(result) <- colnames(x) result } ##' @rdname RcppRoll-exports ##' @export roll_meanr <- function(x, n = 1L, weights = NULL, by = 1L, fill = NA, partial = FALSE, align = "right", normalize = TRUE, na.rm = FALSE) { if (!identical(partial, FALSE)) { warning("'partial' argument is currently unimplemented; using 'partial = FALSE'") partial <- FALSE } result <- roll_mean_impl( x, as.integer(n), as.numeric(weights), as.integer(by), as.numeric(fill), as.logical(partial), as.character(match.arg(align)), as.logical(normalize), as.logical(na.rm) ) colnames(result) <- colnames(x) result } ##' @rdname RcppRoll-exports ##' @export roll_meanl <- function(x, n = 1L, weights = NULL, by = 1L, fill = NA, partial = FALSE, align = "left", normalize = TRUE, na.rm = FALSE) { if (!identical(partial, FALSE)) { warning("'partial' argument is currently unimplemented; using 'partial = FALSE'") partial <- FALSE } result <- roll_mean_impl( x, as.integer(n), as.numeric(weights), as.integer(by), as.numeric(fill), as.logical(partial), as.character(match.arg(align)), as.logical(normalize), as.logical(na.rm) ) colnames(result) <- colnames(x) result } #' @rdname RcppRoll-exports #' @export roll_median <- function(x, n = 1L, weights = NULL, by = 1L, fill = numeric(0), partial = FALSE, align = c("center", "left", "right"), normalize = TRUE, na.rm = FALSE) { if (!identical(partial, FALSE)) { warning("'partial' argument is currently unimplemented; using 'partial = FALSE'") partial <- FALSE } result <- roll_median_impl( x, as.integer(n), as.numeric(weights), as.integer(by), as.numeric(fill), as.logical(partial), as.character(match.arg(align)), as.logical(normalize), as.logical(na.rm) ) colnames(result) <- colnames(x) result } ##' @rdname RcppRoll-exports ##' @export roll_medianr <- function(x, n = 1L, weights = NULL, by = 1L, fill = NA, partial = FALSE, align = "right", normalize = TRUE, na.rm = FALSE) { if (!identical(partial, FALSE)) { warning("'partial' argument is currently unimplemented; using 'partial = FALSE'") partial <- FALSE } result <- roll_median_impl( x, as.integer(n), as.numeric(weights), as.integer(by), as.numeric(fill), as.logical(partial), as.character(match.arg(align)), as.logical(normalize), as.logical(na.rm) ) colnames(result) <- colnames(x) result } ##' @rdname RcppRoll-exports ##' @export roll_medianl <- function(x, n = 1L, weights = NULL, by = 1L, fill = NA, partial = FALSE, align = "left", normalize = TRUE, na.rm = FALSE) { if (!identical(partial, FALSE)) { warning("'partial' argument is currently unimplemented; using 'partial = FALSE'") partial <- FALSE } result <- roll_median_impl( x, as.integer(n), as.numeric(weights), as.integer(by), as.numeric(fill), as.logical(partial), as.character(match.arg(align)), as.logical(normalize), as.logical(na.rm) ) colnames(result) <- colnames(x) result } #' @rdname RcppRoll-exports #' @export roll_min <- function(x, n = 1L, weights = NULL, by = 1L, fill = numeric(0), partial = FALSE, align = c("center", "left", "right"), normalize = TRUE, na.rm = FALSE) { if (!identical(partial, FALSE)) { warning("'partial' argument is currently unimplemented; using 'partial = FALSE'") partial <- FALSE } result <- roll_min_impl( x, as.integer(n), as.numeric(weights), as.integer(by), as.numeric(fill), as.logical(partial), as.character(match.arg(align)), as.logical(normalize), as.logical(na.rm) ) colnames(result) <- colnames(x) result } ##' @rdname RcppRoll-exports ##' @export roll_minr <- function(x, n = 1L, weights = NULL, by = 1L, fill = NA, partial = FALSE, align = "right", normalize = TRUE, na.rm = FALSE) { if (!identical(partial, FALSE)) { warning("'partial' argument is currently unimplemented; using 'partial = FALSE'") partial <- FALSE } result <- roll_min_impl( x, as.integer(n), as.numeric(weights), as.integer(by), as.numeric(fill), as.logical(partial), as.character(match.arg(align)), as.logical(normalize), as.logical(na.rm) ) colnames(result) <- colnames(x) result } ##' @rdname RcppRoll-exports ##' @export roll_minl <- function(x, n = 1L, weights = NULL, by = 1L, fill = NA, partial = FALSE, align = "left", normalize = TRUE, na.rm = FALSE) { if (!identical(partial, FALSE)) { warning("'partial' argument is currently unimplemented; using 'partial = FALSE'") partial <- FALSE } result <- roll_min_impl( x, as.integer(n), as.numeric(weights), as.integer(by), as.numeric(fill), as.logical(partial), as.character(match.arg(align)), as.logical(normalize), as.logical(na.rm) ) colnames(result) <- colnames(x) result } #' @rdname RcppRoll-exports #' @export roll_max <- function(x, n = 1L, weights = NULL, by = 1L, fill = numeric(0), partial = FALSE, align = c("center", "left", "right"), normalize = TRUE, na.rm = FALSE) { if (!identical(partial, FALSE)) { warning("'partial' argument is currently unimplemented; using 'partial = FALSE'") partial <- FALSE } result <- roll_max_impl( x, as.integer(n), as.numeric(weights), as.integer(by), as.numeric(fill), as.logical(partial), as.character(match.arg(align)), as.logical(normalize), as.logical(na.rm) ) colnames(result) <- colnames(x) result } ##' @rdname RcppRoll-exports ##' @export roll_maxr <- function(x, n = 1L, weights = NULL, by = 1L, fill = NA, partial = FALSE, align = "right", normalize = TRUE, na.rm = FALSE) { if (!identical(partial, FALSE)) { warning("'partial' argument is currently unimplemented; using 'partial = FALSE'") partial <- FALSE } result <- roll_max_impl( x, as.integer(n), as.numeric(weights), as.integer(by), as.numeric(fill), as.logical(partial), as.character(match.arg(align)), as.logical(normalize), as.logical(na.rm) ) colnames(result) <- colnames(x) result } ##' @rdname RcppRoll-exports ##' @export roll_maxl <- function(x, n = 1L, weights = NULL, by = 1L, fill = NA, partial = FALSE, align = "left", normalize = TRUE, na.rm = FALSE) { if (!identical(partial, FALSE)) { warning("'partial' argument is currently unimplemented; using 'partial = FALSE'") partial <- FALSE } result <- roll_max_impl( x, as.integer(n), as.numeric(weights), as.integer(by), as.numeric(fill), as.logical(partial), as.character(match.arg(align)), as.logical(normalize), as.logical(na.rm) ) colnames(result) <- colnames(x) result } #' @rdname RcppRoll-exports #' @export roll_prod <- function(x, n = 1L, weights = NULL, by = 1L, fill = numeric(0), partial = FALSE, align = c("center", "left", "right"), normalize = TRUE, na.rm = FALSE) { if (!identical(partial, FALSE)) { warning("'partial' argument is currently unimplemented; using 'partial = FALSE'") partial <- FALSE } result <- roll_prod_impl( x, as.integer(n), as.numeric(weights), as.integer(by), as.numeric(fill), as.logical(partial), as.character(match.arg(align)), as.logical(normalize), as.logical(na.rm) ) colnames(result) <- colnames(x) result } ##' @rdname RcppRoll-exports ##' @export roll_prodr <- function(x, n = 1L, weights = NULL, by = 1L, fill = NA, partial = FALSE, align = "right", normalize = TRUE, na.rm = FALSE) { if (!identical(partial, FALSE)) { warning("'partial' argument is currently unimplemented; using 'partial = FALSE'") partial <- FALSE } result <- roll_prod_impl( x, as.integer(n), as.numeric(weights), as.integer(by), as.numeric(fill), as.logical(partial), as.character(match.arg(align)), as.logical(normalize), as.logical(na.rm) ) colnames(result) <- colnames(x) result } ##' @rdname RcppRoll-exports ##' @export roll_prodl <- function(x, n = 1L, weights = NULL, by = 1L, fill = NA, partial = FALSE, align = "left", normalize = TRUE, na.rm = FALSE) { if (!identical(partial, FALSE)) { warning("'partial' argument is currently unimplemented; using 'partial = FALSE'") partial <- FALSE } result <- roll_prod_impl( x, as.integer(n), as.numeric(weights), as.integer(by), as.numeric(fill), as.logical(partial), as.character(match.arg(align)), as.logical(normalize), as.logical(na.rm) ) colnames(result) <- colnames(x) result } #' @rdname RcppRoll-exports #' @export roll_sum <- function(x, n = 1L, weights = NULL, by = 1L, fill = numeric(0), partial = FALSE, align = c("center", "left", "right"), normalize = TRUE, na.rm = FALSE) { if (!identical(partial, FALSE)) { warning("'partial' argument is currently unimplemented; using 'partial = FALSE'") partial <- FALSE } result <- roll_sum_impl( x, as.integer(n), as.numeric(weights), as.integer(by), as.numeric(fill), as.logical(partial), as.character(match.arg(align)), as.logical(normalize), as.logical(na.rm) ) colnames(result) <- colnames(x) result } ##' @rdname RcppRoll-exports ##' @export roll_sumr <- function(x, n = 1L, weights = NULL, by = 1L, fill = NA, partial = FALSE, align = "right", normalize = TRUE, na.rm = FALSE) { if (!identical(partial, FALSE)) { warning("'partial' argument is currently unimplemented; using 'partial = FALSE'") partial <- FALSE } result <- roll_sum_impl( x, as.integer(n), as.numeric(weights), as.integer(by), as.numeric(fill), as.logical(partial), as.character(match.arg(align)), as.logical(normalize), as.logical(na.rm) ) colnames(result) <- colnames(x) result } ##' @rdname RcppRoll-exports ##' @export roll_suml <- function(x, n = 1L, weights = NULL, by = 1L, fill = NA, partial = FALSE, align = "left", normalize = TRUE, na.rm = FALSE) { if (!identical(partial, FALSE)) { warning("'partial' argument is currently unimplemented; using 'partial = FALSE'") partial <- FALSE } result <- roll_sum_impl( x, as.integer(n), as.numeric(weights), as.integer(by), as.numeric(fill), as.logical(partial), as.character(match.arg(align)), as.logical(normalize), as.logical(na.rm) ) colnames(result) <- colnames(x) result } #' @rdname RcppRoll-exports #' @export roll_sd <- function(x, n = 1L, weights = NULL, by = 1L, fill = numeric(0), partial = FALSE, align = c("center", "left", "right"), normalize = TRUE, na.rm = FALSE) { if (!identical(partial, FALSE)) { warning("'partial' argument is currently unimplemented; using 'partial = FALSE'") partial <- FALSE } result <- roll_sd_impl( x, as.integer(n), as.numeric(weights), as.integer(by), as.numeric(fill), as.logical(partial), as.character(match.arg(align)), as.logical(normalize), as.logical(na.rm) ) colnames(result) <- colnames(x) result } ##' @rdname RcppRoll-exports ##' @export roll_sdr <- function(x, n = 1L, weights = NULL, by = 1L, fill = NA, partial = FALSE, align = "right", normalize = TRUE, na.rm = FALSE) { if (!identical(partial, FALSE)) { warning("'partial' argument is currently unimplemented; using 'partial = FALSE'") partial <- FALSE } result <- roll_sd_impl( x, as.integer(n), as.numeric(weights), as.integer(by), as.numeric(fill), as.logical(partial), as.character(match.arg(align)), as.logical(normalize), as.logical(na.rm) ) colnames(result) <- colnames(x) result } ##' @rdname RcppRoll-exports ##' @export roll_sdl <- function(x, n = 1L, weights = NULL, by = 1L, fill = NA, partial = FALSE, align = "left", normalize = TRUE, na.rm = FALSE) { if (!identical(partial, FALSE)) { warning("'partial' argument is currently unimplemented; using 'partial = FALSE'") partial <- FALSE } result <- roll_sd_impl( x, as.integer(n), as.numeric(weights), as.integer(by), as.numeric(fill), as.logical(partial), as.character(match.arg(align)), as.logical(normalize), as.logical(na.rm) ) colnames(result) <- colnames(x) result } #' @rdname RcppRoll-exports #' @export roll_var <- function(x, n = 1L, weights = NULL, by = 1L, fill = numeric(0), partial = FALSE, align = c("center", "left", "right"), normalize = TRUE, na.rm = FALSE) { if (!identical(partial, FALSE)) { warning("'partial' argument is currently unimplemented; using 'partial = FALSE'") partial <- FALSE } result <- roll_var_impl( x, as.integer(n), as.numeric(weights), as.integer(by), as.numeric(fill), as.logical(partial), as.character(match.arg(align)), as.logical(normalize), as.logical(na.rm) ) colnames(result) <- colnames(x) result } ##' @rdname RcppRoll-exports ##' @export roll_varr <- function(x, n = 1L, weights = NULL, by = 1L, fill = NA, partial = FALSE, align = "right", normalize = TRUE, na.rm = FALSE) { if (!identical(partial, FALSE)) { warning("'partial' argument is currently unimplemented; using 'partial = FALSE'") partial <- FALSE } result <- roll_var_impl( x, as.integer(n), as.numeric(weights), as.integer(by), as.numeric(fill), as.logical(partial), as.character(match.arg(align)), as.logical(normalize), as.logical(na.rm) ) colnames(result) <- colnames(x) result } ##' @rdname RcppRoll-exports ##' @export roll_varl <- function(x, n = 1L, weights = NULL, by = 1L, fill = NA, partial = FALSE, align = "left", normalize = TRUE, na.rm = FALSE) { if (!identical(partial, FALSE)) { warning("'partial' argument is currently unimplemented; using 'partial = FALSE'") partial <- FALSE } result <- roll_var_impl( x, as.integer(n), as.numeric(weights), as.integer(by), as.numeric(fill), as.logical(partial), as.character(match.arg(align)), as.logical(normalize), as.logical(na.rm) ) colnames(result) <- colnames(x) result } RcppRoll/R/RcppRoll-package.R0000644000176200001440000000107013305254656015470 0ustar liggesusers#' RcppRoll #' #' This package implements a number of 'roll'-ing functions for \R #' vectors and matrices. #' #' Currently, the exported functions are: #' \itemize{ #' \item{\code{\link{roll_max}}} #' \item{\code{\link{roll_mean}}} #' \item{\code{\link{roll_median}}} #' \item{\code{\link{roll_min}}} #' \item{\code{\link{roll_prod}}} #' \item{\code{\link{roll_sd}}} #' \item{\code{\link{roll_sum}}} #' \item{\code{\link{roll_var}}} #' } #' #' @name RcppRoll #' @docType package #' @useDynLib RcppRoll, .registration = TRUE #' @importFrom Rcpp evalCpp NULL RcppRoll/R/RcppExports.R0000644000176200001440000000324513305244162014630 0ustar liggesusers# Generated by using Rcpp::compileAttributes() -> do not edit by hand # Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393 na_locf <- function(x) { .Call(`_RcppRoll_na_locf`, x) } roll_mean_impl <- function(x, n, weights, by, fill_, partial, align, normalize, na_rm) { .Call(`_RcppRoll_roll_mean_impl`, x, n, weights, by, fill_, partial, align, normalize, na_rm) } roll_median_impl <- function(x, n, weights, by, fill_, partial, align, normalize, na_rm) { .Call(`_RcppRoll_roll_median_impl`, x, n, weights, by, fill_, partial, align, normalize, na_rm) } roll_min_impl <- function(x, n, weights, by, fill_, partial, align, normalize, na_rm) { .Call(`_RcppRoll_roll_min_impl`, x, n, weights, by, fill_, partial, align, normalize, na_rm) } roll_max_impl <- function(x, n, weights, by, fill_, partial, align, normalize, na_rm) { .Call(`_RcppRoll_roll_max_impl`, x, n, weights, by, fill_, partial, align, normalize, na_rm) } roll_prod_impl <- function(x, n, weights, by, fill_, partial, align, normalize, na_rm) { .Call(`_RcppRoll_roll_prod_impl`, x, n, weights, by, fill_, partial, align, normalize, na_rm) } roll_sum_impl <- function(x, n, weights, by, fill_, partial, align, normalize, na_rm) { .Call(`_RcppRoll_roll_sum_impl`, x, n, weights, by, fill_, partial, align, normalize, na_rm) } roll_sd_impl <- function(x, n, weights, by, fill_, partial, align, normalize, na_rm) { .Call(`_RcppRoll_roll_sd_impl`, x, n, weights, by, fill_, partial, align, normalize, na_rm) } roll_var_impl <- function(x, n, weights, by, fill_, partial, align, normalize, na_rm) { .Call(`_RcppRoll_roll_var_impl`, x, n, weights, by, fill_, partial, align, normalize, na_rm) } RcppRoll/README.md0000644000176200001440000000026713102424446013273 0ustar liggesusersRcppRoll ===== This package provides windowed-versions of commonly-used mathematical and statistical functions. Install me with devtools: install_github("kevinushey/RcppRoll") RcppRoll/MD50000644000176200001440000000131413305553767012334 0ustar liggesusers3c4df96e208c55203f49e8fab32bc1e4 *DESCRIPTION 64ae1212d55e613813797cb87210600b *NAMESPACE aa8bfe9935a9ac5bc5629f8c52085101 *NEWS.md 28dec2a853d2aa81e99191bb7007dfbf *R/RcppExports.R e1477351e277011c2ba6da62ed00a306 *R/RcppRoll-package.R 8ecb3c5b4d07ea0bf873ab2f9a91c12d *R/RcppRoll.R fc515078e31059a855f50c1aee54741c *README.md c6164170410695a001115eb1bc742404 *man/RcppRoll-exports.Rd 754aa156488afe89c1bbe37594b336c2 *man/RcppRoll.Rd c027b136240f63206edeafc2d6f6629d *src/RcppExports.cpp 6603d7f6dfecf6213d9578146f96d49a *src/RcppRoll.cpp 87b45a6ab1228dd20d570591244e44f5 *tests/testthat.R 7ec0ea81c7747a5def02bf90e5927422 *tests/testthat/test-weights.R 3e4582ecb2c256ad08fe7a89cece1a82 *tests/testthat/test-zoo.R RcppRoll/DESCRIPTION0000644000176200001440000000123313305553767013532 0ustar liggesusersPackage: RcppRoll Type: Package Title: Efficient Rolling / Windowed Operations Version: 0.3.0 Date: 2018-06-05 Author: Kevin Ushey Maintainer: Kevin Ushey Description: Provides fast and efficient routines for common rolling / windowed operations. Routines for the efficient computation of windowed mean, median, sum, product, minimum, maximum, standard deviation and variance are provided. License: GPL (>= 2) Depends: R (>= 2.15.1) Suggests: zoo, testthat Imports: Rcpp LinkingTo: Rcpp RoxygenNote: 6.0.1 NeedsCompilation: yes Packaged: 2018-06-05 17:45:24 UTC; kevin Repository: CRAN Date/Publication: 2018-06-05 18:35:35 UTC RcppRoll/man/0000755000176200001440000000000013102424373012561 5ustar liggesusersRcppRoll/man/RcppRoll.Rd0000644000176200001440000000114113305243170014601 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/RcppRoll-package.R \docType{package} \name{RcppRoll} \alias{RcppRoll} \alias{RcppRoll-package} \title{RcppRoll} \description{ This package implements a number of 'roll'-ing functions for \R vectors and matrices. } \details{ Currently, the exported functions are: \itemize{ \item{\code{\link{roll_max}}} \item{\code{\link{roll_mean}}} \item{\code{\link{roll_median}}} \item{\code{\link{roll_min}}} \item{\code{\link{roll_prod}}} \item{\code{\link{roll_sd}}} \item{\code{\link{roll_sum}}} \item{\code{\link{roll_var}}} } } RcppRoll/man/RcppRoll-exports.Rd0000644000176200001440000001162013305254660016314 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/RcppRoll.R \name{RcppRoll-exports} \alias{RcppRoll-exports} \alias{roll_mean} \alias{roll_meanr} \alias{roll_meanl} \alias{roll_median} \alias{roll_medianr} \alias{roll_medianl} \alias{roll_min} \alias{roll_minr} \alias{roll_minl} \alias{roll_max} \alias{roll_maxr} \alias{roll_maxl} \alias{roll_prod} \alias{roll_prodr} \alias{roll_prodl} \alias{roll_sum} \alias{roll_sumr} \alias{roll_suml} \alias{roll_sd} \alias{roll_sdr} \alias{roll_sdl} \alias{roll_var} \alias{roll_varr} \alias{roll_varl} \title{RcppRoll} \usage{ roll_mean(x, n = 1L, weights = NULL, by = 1L, fill = numeric(0), partial = FALSE, align = c("center", "left", "right"), normalize = TRUE, na.rm = FALSE) roll_meanr(x, n = 1L, weights = NULL, by = 1L, fill = NA, partial = FALSE, align = "right", normalize = TRUE, na.rm = FALSE) roll_meanl(x, n = 1L, weights = NULL, by = 1L, fill = NA, partial = FALSE, align = "left", normalize = TRUE, na.rm = FALSE) roll_median(x, n = 1L, weights = NULL, by = 1L, fill = numeric(0), partial = FALSE, align = c("center", "left", "right"), normalize = TRUE, na.rm = FALSE) roll_medianr(x, n = 1L, weights = NULL, by = 1L, fill = NA, partial = FALSE, align = "right", normalize = TRUE, na.rm = FALSE) roll_medianl(x, n = 1L, weights = NULL, by = 1L, fill = NA, partial = FALSE, align = "left", normalize = TRUE, na.rm = FALSE) roll_min(x, n = 1L, weights = NULL, by = 1L, fill = numeric(0), partial = FALSE, align = c("center", "left", "right"), normalize = TRUE, na.rm = FALSE) roll_minr(x, n = 1L, weights = NULL, by = 1L, fill = NA, partial = FALSE, align = "right", normalize = TRUE, na.rm = FALSE) roll_minl(x, n = 1L, weights = NULL, by = 1L, fill = NA, partial = FALSE, align = "left", normalize = TRUE, na.rm = FALSE) roll_max(x, n = 1L, weights = NULL, by = 1L, fill = numeric(0), partial = FALSE, align = c("center", "left", "right"), normalize = TRUE, na.rm = FALSE) roll_maxr(x, n = 1L, weights = NULL, by = 1L, fill = NA, partial = FALSE, align = "right", normalize = TRUE, na.rm = FALSE) roll_maxl(x, n = 1L, weights = NULL, by = 1L, fill = NA, partial = FALSE, align = "left", normalize = TRUE, na.rm = FALSE) roll_prod(x, n = 1L, weights = NULL, by = 1L, fill = numeric(0), partial = FALSE, align = c("center", "left", "right"), normalize = TRUE, na.rm = FALSE) roll_prodr(x, n = 1L, weights = NULL, by = 1L, fill = NA, partial = FALSE, align = "right", normalize = TRUE, na.rm = FALSE) roll_prodl(x, n = 1L, weights = NULL, by = 1L, fill = NA, partial = FALSE, align = "left", normalize = TRUE, na.rm = FALSE) roll_sum(x, n = 1L, weights = NULL, by = 1L, fill = numeric(0), partial = FALSE, align = c("center", "left", "right"), normalize = TRUE, na.rm = FALSE) roll_sumr(x, n = 1L, weights = NULL, by = 1L, fill = NA, partial = FALSE, align = "right", normalize = TRUE, na.rm = FALSE) roll_suml(x, n = 1L, weights = NULL, by = 1L, fill = NA, partial = FALSE, align = "left", normalize = TRUE, na.rm = FALSE) roll_sd(x, n = 1L, weights = NULL, by = 1L, fill = numeric(0), partial = FALSE, align = c("center", "left", "right"), normalize = TRUE, na.rm = FALSE) roll_sdr(x, n = 1L, weights = NULL, by = 1L, fill = NA, partial = FALSE, align = "right", normalize = TRUE, na.rm = FALSE) roll_sdl(x, n = 1L, weights = NULL, by = 1L, fill = NA, partial = FALSE, align = "left", normalize = TRUE, na.rm = FALSE) roll_var(x, n = 1L, weights = NULL, by = 1L, fill = numeric(0), partial = FALSE, align = c("center", "left", "right"), normalize = TRUE, na.rm = FALSE) roll_varr(x, n = 1L, weights = NULL, by = 1L, fill = NA, partial = FALSE, align = "right", normalize = TRUE, na.rm = FALSE) roll_varl(x, n = 1L, weights = NULL, by = 1L, fill = NA, partial = FALSE, align = "left", normalize = TRUE, na.rm = FALSE) } \arguments{ \item{x}{A numeric vector or a numeric matrix.} \item{n}{The window size. Ignored when \code{weights} is non-\code{NULL}.} \item{weights}{A vector of length \code{n}, giving the weights for each element within a window. If \code{NULL}, we take unit weights of width \code{n}.} \item{by}{Calculate at every \code{by}-th point rather than every point.} \item{fill}{Either an empty vector (no fill), or a vector (recycled to) length 3 giving left, middle and right fills.} \item{partial}{Partial application? Currently unimplemented.} \item{align}{Align windows on the \code{"left"}, \code{"center"} or \code{"right"}.} \item{normalize}{Normalize window weights, such that they sum to \code{n}.} \item{na.rm}{Remove missing values?} } \description{ Efficient windowed / rolling operations. Each function here applies an operation over a moving window of size \code{n}, with (customizable) weights specified through \code{weights}. } \details{ The functions postfixed with \code{l} and \code{r} are convenience wrappers that set \strong{l}eft / \strong{r}ight alignment of the windowed operations. }