RcppRoll/0000755000176200001440000000000012510070772012010 5ustar liggesusersRcppRoll/src/0000755000176200001440000000000012510067307012577 5ustar liggesusersRcppRoll/src/rollit.cpp0000644000176200001440000005534112510067307014620 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 = 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; if (by > 1) { result = static_cast(no_init(output_n)); } else { result = T(output_n, fill.middle()); } // pad left for (int i = 0; i < padLeftTimes; ++i) { result[i] = fill.left(); } // fill result if (weights.size()) { for (int i = padLeftTimes; i < padLeftTimes + ops_n; i += by) { result[i] = f(x, i - padLeftTimes, weights, n); } } else { for (int i = padLeftTimes; i < padLeftTimes + ops_n; i += by) { result[i] = f(x, i - padLeftTimes, n); } } // pad right for (int i = padLeftTimes + ops_n; i < padLeftTimes + ops_n + padRightTimes; ++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 ops_n = x_n - n + 1; int output_n = ops_n; T result; if (by > 1) { result = static_cast(no_init(output_n)); } else { result = T(output_n, fill.middle()); } // fill result if (weights.size()) { for (int i = 0; i < ops_n; i += by) { result[i] = f(x, i, weights, n); } } else { for (int i = 0; i < ops_n; i += by) { result[i] = f(x, i, n); } } 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 // Begin auto-generated exports (internal/make_exports.R) // [[Rcpp::export(.RcppRoll_mean)]] SEXP roll_mean(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(.RcppRoll_median)]] SEXP roll_median(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(.RcppRoll_min)]] SEXP roll_min(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(.RcppRoll_max)]] SEXP roll_max(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(.RcppRoll_prod)]] SEXP roll_prod(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(.RcppRoll_sum)]] SEXP roll_sum(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(.RcppRoll_sd)]] SEXP roll_sd(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(.RcppRoll_var)]] SEXP roll_var(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/src/RcppExports.cpp0000644000176200001440000002201212510067307015571 0ustar liggesusers// This file was generated by Rcpp::compileAttributes // Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393 #include using namespace Rcpp; // roll_mean SEXP roll_mean(SEXP x, int n, NumericVector weights, int by, NumericVector fill_, bool partial, String align, bool normalize, bool na_rm); RcppExport SEXP RcppRoll_roll_mean(SEXP xSEXP, SEXP nSEXP, SEXP weightsSEXP, SEXP bySEXP, SEXP fill_SEXP, SEXP partialSEXP, SEXP alignSEXP, SEXP normalizeSEXP, SEXP na_rmSEXP) { BEGIN_RCPP Rcpp::RObject __result; Rcpp::RNGScope __rngScope; 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); __result = Rcpp::wrap(roll_mean(x, n, weights, by, fill_, partial, align, normalize, na_rm)); return __result; END_RCPP } // roll_median SEXP roll_median(SEXP x, int n, NumericVector weights, int by, NumericVector fill_, bool partial, String align, bool normalize, bool na_rm); RcppExport SEXP RcppRoll_roll_median(SEXP xSEXP, SEXP nSEXP, SEXP weightsSEXP, SEXP bySEXP, SEXP fill_SEXP, SEXP partialSEXP, SEXP alignSEXP, SEXP normalizeSEXP, SEXP na_rmSEXP) { BEGIN_RCPP Rcpp::RObject __result; Rcpp::RNGScope __rngScope; 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); __result = Rcpp::wrap(roll_median(x, n, weights, by, fill_, partial, align, normalize, na_rm)); return __result; END_RCPP } // roll_min SEXP roll_min(SEXP x, int n, NumericVector weights, int by, NumericVector fill_, bool partial, String align, bool normalize, bool na_rm); RcppExport SEXP RcppRoll_roll_min(SEXP xSEXP, SEXP nSEXP, SEXP weightsSEXP, SEXP bySEXP, SEXP fill_SEXP, SEXP partialSEXP, SEXP alignSEXP, SEXP normalizeSEXP, SEXP na_rmSEXP) { BEGIN_RCPP Rcpp::RObject __result; Rcpp::RNGScope __rngScope; 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); __result = Rcpp::wrap(roll_min(x, n, weights, by, fill_, partial, align, normalize, na_rm)); return __result; END_RCPP } // roll_max SEXP roll_max(SEXP x, int n, NumericVector weights, int by, NumericVector fill_, bool partial, String align, bool normalize, bool na_rm); RcppExport SEXP RcppRoll_roll_max(SEXP xSEXP, SEXP nSEXP, SEXP weightsSEXP, SEXP bySEXP, SEXP fill_SEXP, SEXP partialSEXP, SEXP alignSEXP, SEXP normalizeSEXP, SEXP na_rmSEXP) { BEGIN_RCPP Rcpp::RObject __result; Rcpp::RNGScope __rngScope; 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); __result = Rcpp::wrap(roll_max(x, n, weights, by, fill_, partial, align, normalize, na_rm)); return __result; END_RCPP } // roll_prod SEXP roll_prod(SEXP x, int n, NumericVector weights, int by, NumericVector fill_, bool partial, String align, bool normalize, bool na_rm); RcppExport SEXP RcppRoll_roll_prod(SEXP xSEXP, SEXP nSEXP, SEXP weightsSEXP, SEXP bySEXP, SEXP fill_SEXP, SEXP partialSEXP, SEXP alignSEXP, SEXP normalizeSEXP, SEXP na_rmSEXP) { BEGIN_RCPP Rcpp::RObject __result; Rcpp::RNGScope __rngScope; 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); __result = Rcpp::wrap(roll_prod(x, n, weights, by, fill_, partial, align, normalize, na_rm)); return __result; END_RCPP } // roll_sum SEXP roll_sum(SEXP x, int n, NumericVector weights, int by, NumericVector fill_, bool partial, String align, bool normalize, bool na_rm); RcppExport SEXP RcppRoll_roll_sum(SEXP xSEXP, SEXP nSEXP, SEXP weightsSEXP, SEXP bySEXP, SEXP fill_SEXP, SEXP partialSEXP, SEXP alignSEXP, SEXP normalizeSEXP, SEXP na_rmSEXP) { BEGIN_RCPP Rcpp::RObject __result; Rcpp::RNGScope __rngScope; 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); __result = Rcpp::wrap(roll_sum(x, n, weights, by, fill_, partial, align, normalize, na_rm)); return __result; END_RCPP } // roll_sd SEXP roll_sd(SEXP x, int n, NumericVector weights, int by, NumericVector fill_, bool partial, String align, bool normalize, bool na_rm); RcppExport SEXP RcppRoll_roll_sd(SEXP xSEXP, SEXP nSEXP, SEXP weightsSEXP, SEXP bySEXP, SEXP fill_SEXP, SEXP partialSEXP, SEXP alignSEXP, SEXP normalizeSEXP, SEXP na_rmSEXP) { BEGIN_RCPP Rcpp::RObject __result; Rcpp::RNGScope __rngScope; 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); __result = Rcpp::wrap(roll_sd(x, n, weights, by, fill_, partial, align, normalize, na_rm)); return __result; END_RCPP } // roll_var SEXP roll_var(SEXP x, int n, NumericVector weights, int by, NumericVector fill_, bool partial, String align, bool normalize, bool na_rm); RcppExport SEXP RcppRoll_roll_var(SEXP xSEXP, SEXP nSEXP, SEXP weightsSEXP, SEXP bySEXP, SEXP fill_SEXP, SEXP partialSEXP, SEXP alignSEXP, SEXP normalizeSEXP, SEXP na_rmSEXP) { BEGIN_RCPP Rcpp::RObject __result; Rcpp::RNGScope __rngScope; 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); __result = Rcpp::wrap(roll_var(x, n, weights, by, fill_, partial, align, normalize, na_rm)); return __result; END_RCPP } RcppRoll/NAMESPACE0000644000176200001440000000112512510057554013231 0ustar liggesusers# Generated by roxygen2 (4.1.0): do not edit by hand export(get_rollit_source) 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) export(rollit) export(rollit_raw) importFrom(Rcpp,sourceCpp) useDynLib(RcppRoll) RcppRoll/R/0000755000176200001440000000000012510060324012201 5ustar liggesusersRcppRoll/R/rollit_raw.R0000644000176200001440000001562612510061074014517 0ustar liggesusers#' Generate your own Weighted C++ Roll Function #' #' Using this, you can write and wrap in your own C++ function. #' #' The signature of \code{fun} is fixed as: #' #' \code{double ( NumericVector& x, NumericVector& weights, const int& n, const int& N, const int& ind)} #' #' where #' #' \itemize{ #' #' \item{\code{X_SUB} is a \code{#define} macro that expands to the sub-vector being rolled over,} #' #' \item{\code{X(i)} is a \code{#define} macro that expands to the current element of \code{X_SUB} #' in a loop being rolled over,} #' #' \item{\code{x} is a reference to the \bold{entire} vector (not just the #' sub-vector being rolled over),} #' #' \item{\code{weights} are the weights,} #' #' \item{\code{n} is the window size,} #' #' \item{\code{N} is the number of non-zero \code{weights} passed,} #' #' \item{\code{ind} is the current position along vector \code{x}.} #' } #' #' Because the variables are being passed by reference, you #' should \bold{not} modify them, unless you're prepared for strange behavior. #' See examples for a potential usage. #' #' @param fun A character string defining the function call. See examples #' for usage. #' @param includes Other C++ libraries to include. For example, to include #' \code{boost/math.hpp}, you would pass #' \code{c("")}. #' @param depends Other libraries to link to. Linking is done through #' Rcpp attributes. #' @param inline boolean; mark this function as inline? This may or may not #' increase execution speed. #' @param name string; a name to internally assign to your generated C++ functions. #' @param additional Other C++ code you want to include; e.g. helper functions. #' This code will be inserted as-is above the code in \code{fun}. #' @param ... Optional arguments passed to \code{sourceCpp}. #' @export #' @examples \dontrun{ #' ## implement a weighted rolling 'sum of squares' #' fun <- " #' double out = 0; #' const double m = mean( X_SUB ); #' for( int i=0; i < n; i++ ) { #' out += weights[i] * ( (X(i)-m) * (X(i)-m) ) / (N-1); #' } #' return out; #' " #' #' rolling_var <- rollit_raw( fun ) #' x <- 1:5 #' rolling_var( x, 5 ) == var(x) #' #' ## a (slow-ish) implementation of rolling kurtosis #' fun <- " #' double numerator = 0; #' double denominator = 0; #' const double m = mean( X_SUB ); #' for( int i=0; i < n; i++ ) { #' double tmp = ( X(i) - m ) * ( X(i) - m ); #' numerator += tmp * tmp; #' denominator += tmp; #' } #' return N * numerator / ( denominator * denominator ); #' " #' #' rolling_kurt <- rollit_raw( fun ) #' x <- rnorm(100) #' rolling_kurt(x, 20) #' } rollit_raw <- function(fun, depends = NULL, includes = NULL, inline = TRUE, name = NULL, additional = NULL, ...) { .Deprecated() ## random name if null if (is.null(name)) { random_string <- sample(c(letters, LETTERS, 0:9), 20, TRUE) name <- paste(sep = "", collapse = "", c("z", random_string)) } ## environment for cppSource generated files cpp_env <- new.env() outFile <- paste(sep = "", tempfile(), ".cpp") conn <- file(outFile, open = "w") on.exit(close(conn)) w <- function(...) { cat(paste0(..., "\n"), file = conn) } w1 <- function(...) { cat(paste0("\t", ..., "\n"), file = conn) } w2 <- function(...) { cat(paste0("\t\t", ..., "\n"), file = conn) } w3 <- function(...) { cat(paste0("\t\t\t", ..., "\n"), file = conn) } w4 <- function(...) { cat(paste0("\t\t\t\t", ..., "\n"), file = conn) } ## depends if (is.null(depends)) { w("// [[Rcpp::depends(RcppArmadillo)]]") } else { w("// [[Rcpp::depends(RcppArmadillo, ", paste(depends, collapse = ", "), ")") } w("#include ") if (!is.null(includes)) { for(include in includes) { w(paste0("#include ", include)) w() } } ## defines w("#ifndef X_SUB") w("#define X_SUB (x[ seq(ind, ind+n-1) ])") w("#endif") w() w("#ifndef X(i)") w("#define X(i) (x[i+ind])") w("#endif") w() ## namespace w("using namespace Rcpp;") w() w(additional) w() ## wrap the function provided by the user if (inline) w("inline") w( "double ", name, "(NumericVector& x, NumericVector& weights, const int& n, const int& N, const int& ind) {" ) w(fun) w("}") ## numericvector call w("// [[Rcpp::export]]") w("NumericVector ", name, "_numeric( NumericVector x, int n, NumericVector weights ) {") w1() w1("int len = x.size();") w1("int len_out = len - n + 1;") w1("int N = sum( sign( weights*weights ) );") w1() w1("NumericVector out = no_init( len_out );") w1() w1("for( int ind=0; ind < len_out; ind++ ) {") w2() w2("out[ind] = ", name, "(x, weights, n, N, ind );") w1("}") w1() w1("return out;") w1() w("}") w() ## function definition -- matrix w("// [[Rcpp::export]]") w( "NumericMatrix ", name, "_matrix( NumericMatrix A, int n, bool by_column, NumericVector weights ) {" ) w1() w1("int nRow = A.nrow();") w1("int nCol = A.ncol();") w1("int N = sum( sign( weights*weights ) );") ## by column w1("if( by_column ) {") w2() w2("NumericMatrix B( nRow - n + 1, nCol );") w2() w2("for( int j=0; j < nCol; j++ ) {") w3() w3("NumericVector tmp = A(_, j);") w3("for( int ind=0; ind < nRow - n + 1; ind++ ) {") w4() w4("B(ind, j) = ", name, "( tmp, weights, n, N, ind );") w3("}") w2("}") w2() w1("return B;") w1() ## by row w1("} else {") w2() w2("NumericMatrix B( nRow, nCol - n + 1 );") w2() w2("for( int i=0; i < nRow; i++ ) {") w3() w3("NumericVector tmp = A(i, _);") w3("for( int ind=0; ind < nCol - n + 1; ind++ ) {") w4() w4("B(i, ind) = ", name, "( tmp, weights, n, N, ind );") w3("}") w2("}") w2() w1("return B;") w1() w1("}") w() w("}") cat("C++ source file written to", outFile, ".\n") cat("Compiling...\n") sourceCpp(outFile, env = cpp_env, ...) cat("Done!\n") return(function(x, n, by.column = TRUE, weights = rep(1,n), normalize = FALSE) { force(outFile) if (length(weights) != n) { stop("length of weights must equal n") } if (normalize) { weights <- weights * length(weights) / sum(weights) } if (is.matrix(x)) { if (n > nrow(x)) { stop("n cannot be greater than nrow(x)") } call <- call( paste(sep = "", name, "_matrix"), x, as.integer(n), as.logical(by.column), as.numeric(weights) ) return(eval(call, envir = cpp_env)) } if (is.vector(x)) { if (n > length(x)) { stop("n cannot be greater than length(x)") } call <- call(paste(sep = "", name, "_numeric"), x, as.integer(n), as.numeric(weights)) return(as.numeric(eval(call, envir = cpp_env))) } stop("the x supplied is neither a vector nor a matrix") }) } RcppRoll/R/RcppRoll-package.R0000644000176200001440000000112112457034422015457 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 #' @seealso \code{\link{rollit}} for 'roll'-ing your own custom functions. NULL RcppRoll/R/rollit_generated.R0000644000176200001440000002634012510062777015672 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 supply \strong{l}eft ##' and \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{"middle"} 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) { return(.RcppRoll_mean( 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) )) } ##' @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) { return(.RcppRoll_mean( 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) )) } ##' @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) { return(.RcppRoll_mean( 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) )) } ##' @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) { return(.RcppRoll_median( 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) )) } ##' @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) { return(.RcppRoll_median( 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) )) } ##' @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) { return(.RcppRoll_median( 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) )) } ##' @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) { return(.RcppRoll_min( 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) )) } ##' @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) { return(.RcppRoll_min( 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) )) } ##' @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) { return(.RcppRoll_min( 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) )) } ##' @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) { return(.RcppRoll_max( 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) )) } ##' @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) { return(.RcppRoll_max( 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) )) } ##' @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) { return(.RcppRoll_max( 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) )) } ##' @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) { return(.RcppRoll_prod( 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) )) } ##' @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) { return(.RcppRoll_prod( 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) )) } ##' @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) { return(.RcppRoll_prod( 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) )) } ##' @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) { return(.RcppRoll_sum( 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) )) } ##' @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) { return(.RcppRoll_sum( 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) )) } ##' @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) { return(.RcppRoll_sum( 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) )) } ##' @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) { return(.RcppRoll_sd( 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) )) } ##' @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) { return(.RcppRoll_sd( 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) )) } ##' @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) { return(.RcppRoll_sd( 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) )) } ##' @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) { return(.RcppRoll_var( 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) )) } ##' @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) { return(.RcppRoll_var( 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) )) } ##' @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) { return(.RcppRoll_var( 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) )) } RcppRoll/R/RcppExports.R0000644000176200001440000000332612457034422014633 0ustar liggesusers# This file was generated by Rcpp::compileAttributes # Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393 .RcppRoll_mean <- function(x, n, weights, by, fill_, partial, align, normalize, na_rm) { .Call('RcppRoll_roll_mean', PACKAGE = 'RcppRoll', x, n, weights, by, fill_, partial, align, normalize, na_rm) } .RcppRoll_median <- function(x, n, weights, by, fill_, partial, align, normalize, na_rm) { .Call('RcppRoll_roll_median', PACKAGE = 'RcppRoll', x, n, weights, by, fill_, partial, align, normalize, na_rm) } .RcppRoll_min <- function(x, n, weights, by, fill_, partial, align, normalize, na_rm) { .Call('RcppRoll_roll_min', PACKAGE = 'RcppRoll', x, n, weights, by, fill_, partial, align, normalize, na_rm) } .RcppRoll_max <- function(x, n, weights, by, fill_, partial, align, normalize, na_rm) { .Call('RcppRoll_roll_max', PACKAGE = 'RcppRoll', x, n, weights, by, fill_, partial, align, normalize, na_rm) } .RcppRoll_prod <- function(x, n, weights, by, fill_, partial, align, normalize, na_rm) { .Call('RcppRoll_roll_prod', PACKAGE = 'RcppRoll', x, n, weights, by, fill_, partial, align, normalize, na_rm) } .RcppRoll_sum <- function(x, n, weights, by, fill_, partial, align, normalize, na_rm) { .Call('RcppRoll_roll_sum', PACKAGE = 'RcppRoll', x, n, weights, by, fill_, partial, align, normalize, na_rm) } .RcppRoll_sd <- function(x, n, weights, by, fill_, partial, align, normalize, na_rm) { .Call('RcppRoll_roll_sd', PACKAGE = 'RcppRoll', x, n, weights, by, fill_, partial, align, normalize, na_rm) } .RcppRoll_var <- function(x, n, weights, by, fill_, partial, align, normalize, na_rm) { .Call('RcppRoll_roll_var', PACKAGE = 'RcppRoll', x, n, weights, by, fill_, partial, align, normalize, na_rm) } RcppRoll/R/get_rollit_source.R0000644000176200001440000000155612510060302016053 0ustar liggesusers#' Get and Edit Source File Associated with User-Generated 'rollit' Function #' #' This function returns and opens the source file associated with #' a particular 'rollit' function for debugging. We use \R's #' \code{file.edit} interface. #' #' @param fun The generated 'rollit' function. #' @param edit boolean; open the C++ source file in a text editor? #' @param RStudio boolean; open the C++ source file in RStudio? #' @param ... Optional arguments passed to \code{\link{file.edit}}. #' @export get_rollit_source <- function(fun, edit=TRUE, RStudio=FALSE, ...) { file <- get( "outFile", envir=environment( fun ) ) if( !file.exists(file) ) { stop("File does not exist!") } if( edit ) { if( RStudio ) { file.edit( file, editor="RStudio", ... ) } else { file.edit( file, ... ) } } return( file ) } RcppRoll/R/rollit.R0000644000176200001440000002453612510061012013636 0ustar liggesusers#' Generate your own Weighted C++ Roll Function #' #' Using this interface, you can define a function that you would like to #' be called on each sub-vector you are rolling over. The generated code is #' compiled and exposed via \code{sourceCpp}. #' #' By default, we include \code{} in each file; however, you can #' include your own libraries with the \code{includes} call. #' #' @param fun A character string defining the function call. The function must be in #' terms of \code{x}. The function will be applied individually #' to each element being 'roll'ed over, unless \code{vector} is \code{TRUE}. #' @param vector boolean; if \code{TRUE}, then \code{fun} is a scalar-valued #' function of a vector, rather than a function to apply to each element #' individually. #' @param const_vars Constant variables that will live within #' the sourced C++ function. Format is a named \code{list}; e.g, you #' could pass \code{list(e=exp(1))} to have \code{e} as a constant variable #' available in the function being called. Note that the variable \code{N} #' is fixed to be the number of non-zero weights passed, to facilitate the use #' of \code{0} weights in terms of skipping elements. #' @param combine character; typically one of \code{"+", "-", "*", "/"}, but #' any operator usable as a C++ compound assignment operator is accepted. #' This specifies how each element should be combined in the rolling function. #' Only used when \code{vector} is \code{FALSE}. #' @param final_trans A final transformation to perform after either 'rolling' #' over each element in the vector \code{x} (with \code{vector=FALSE}), #' or after applying a scalar-valued function of a vector (with \code{vector=TRUE}). #' Must be in terms of \code{x}. #' @param includes Other C++ libraries to include. For example, to include #' \code{boost/math.hpp}, you would pass #' \code{c("")}. #' @param depends Other libraries to link to. Linking is done through #' Rcpp attributes. #' @param inline boolean; mark the function generated as \code{inline}? #' This may or may not increase execution speed. #' @param name string; a name to internally assign to your generated C++ functions. #' @param ... Additional arguments passed to \code{sourceCpp}. #' @return A wrapper \R function that calls compiled C++ files, as generated through #' \code{sourceCpp}. See \code{\link{rollit_example}} for more information on the #' functions generated by \code{rollit}. #' @export #' @seealso \code{\link{rollit_example}} for an example of the function signature #' for functions generated with \code{rollit}, #' \code{\link{sourceCpp}} for information on how Rcpp #' compiles your functions, \code{\link{get_rollit_source}} for #' inspection of the generated C++ code, and \code{\link{rollit_raw}} for #' wrapping in your own C++ code. #' @note All functions generated use Rcpp's \code{NumericVector} and #' \code{NumericMatrix} to interface with \R vectors and matrices. #' Elements within these vectors are #' translated as \code{double}s so any function that receives a \code{double} #' will work fine. #' #' If you want to just write your own C++ function to wrap into a 'rolling' #' interface, see \code{\link{rollit_raw}}. #' #' @examples \dontrun{ #' x <- matrix(1:16, nrow=4) #' #' ## the squared rolling sum -- we square the sum of our rolled results #' rolling_sqsum <- rollit( final_trans="x*x" ) #' #' rolling_sqsum( x, 4 ) #' rolling_sqsum( x, 4, by.column=FALSE ) #' cbind( as.vector(rolling_sqsum(x, 4)), apply(x, 2, function(x) { sum(x)^2 } ) ) #' #' ## implement your own variance function #' ## we can use the sugar function 'mean' to get #' ## the mean of x #' #' const_vars <- list(m = "mean(x)") #' var_fun <- "( (x-m) * (x-m) )/(N-1)" #' rolling_var <- rollit( var_fun, const_vars=const_vars ) #' #' x <- c(1, 5, 10, 15) #' cbind( rolling_var(x, 2), roll_var(x, 2) ) #' #' ## use a function from cmath #' #' rolling_log10 <- rollit( "log10(x)" ) #' rolling_log10( 10^(1:5), 2 ) #' #' ## rolling product #' rolling_prod <- rollit( combine="*" ) #' rolling_prod( 1:10, 2 ) #' #' ## using weights to specify something like a 'by' argument #' rolling_prod( 1:10, 3, weights=c(1,0,1) ) #' #' ## a benchmark #' #' if( require("microbenchmark") && require("zoo") ) { #' x <- rnorm(1E4) #' microbenchmark( #' rolling_var(x, 100), #' roll_var(x, 100), #' rollapply(x, 100, var), #' times=10 #' ) #' }} #' @importFrom Rcpp sourceCpp rollit <- function(fun = "x", vector = FALSE, const_vars = NULL, combine = "+", final_trans = NULL, includes = NULL, depends = NULL, inline = TRUE, name = NULL, ...) { .Deprecated() ## error checks if (!is.null(const_vars)) { if (!is.list(const_vars) || is.list(const_vars) && is.null(names(const_vars))) { stop("'const_vars' must be a named list") } } if (length(combine) > 1 || !(combine %in% c("+", "-", "*", "/", "&", "|", "^", "<<", ">>"))) { stop("combine must be one of '+', '-', '*', '/', '&', '|', '^', '<<', '>>'") } funky_regex <- "([^a-zA-Z_])(x)(?=[^x])|(\\Ax)|(x\\z)" if (length(grep(funky_regex, fun, perl = TRUE)) < 1) { stop("'fun' must be in terms of a variable 'x'") } ## random name if null if (is.null(name)) { random_string <- sample(c(letters, LETTERS, 0:9), 20, TRUE) name <- paste(sep = "", collapse = "", c("z", random_string)) } ## environment for cppSource generated files cpp_env <- new.env() outFile <- paste(sep = "", tempfile(), ".cpp") conn <- file(outFile, open = "w") on.exit(close(conn)) w <- function(...) { cat(paste0(..., "\n"), file = conn) } w1 <- function(...) { cat(paste0("\t", ..., "\n"), file = conn) } w2 <- function(...) { cat(paste0("\t\t", ..., "\n"), file = conn) } w3 <- function(...) { cat(paste0("\t\t\t", ..., "\n"), file = conn) } w4 <- function(...) { cat(paste0("\t\t\t\t", ..., "\n"), file = conn) } ## depends if (is.null(depends)) { w("// [[Rcpp::depends(RcppArmadillo)]]") } else { w("// [[Rcpp::depends(RcppArmadillo, ", paste(depends, collapse = ", "), ")") } w("#include ") if (!is.null(includes)) { for (include in includes) { w(paste0("#include ", include)) w() } } ## namespace w("using namespace Rcpp;") w() w("typedef NumericVector::iterator iter;") w("typedef NumericVector NV;") w("typedef NumericMatrix NM;") w() ## wrap the function provided by the user if (inline) w("inline") w("double ", name, "(NV& x, NV& weights, const int& n, const int& N, const int& ind) {") if (combine %in% c("+", "-")) { w1("double out_ = 0;") } else { w1("double out_ = 1;") } ## constant variables ## be sure to parse any functions of x within the constant variables if (!is.null(const_vars)) { for(i in seq_along(const_vars)) { tmp <- gsub(funky_regex, "\\1\\2\\3\\4\\5[ seq(ind, ind+n-1) ]", const_vars[i], perl = TRUE) w1("const double ", names(const_vars)[i], " = ", tmp, ";") } } ## funky parser (parsed_fun <- gsub(funky_regex, "\\1\\2\\3\\4\\5[i+ind]", fun, perl = TRUE)) ## apply function as vector if (vector) { w1( "out_ = ", gsub( funky_regex, "\\1\\2\\3\\4\\5[ seq(ind, ind+n-1) ] * weights", fun, perl = TRUE ), ";" ) } else { ## apply function elementwise w1("for( int i=0; i < n; i++ ) {") w2("if( weights[i] != 0 ) {") w3("out_ ", combine, "= weights[i] * ", parsed_fun, ";") w2("}") w1("}") } if (!is.null(final_trans)) { w1("out_ = ", gsub(funky_regex, "\\1out_", final_trans, perl = TRUE), ";") } w1("return out_;") w("}") w() ## numericvector call w("// [[Rcpp::export]]") w("NumericVector ", name, "_numeric( NumericVector x, int n, NumericVector weights ) {") w1() w1("int len = x.size();") w1("int len_out = len - n + 1;") w1("int N = sum( sign( weights*weights ) );") w1() w1("NV out = no_init( len_out );") w1() w1("for( int ind=0; ind < len_out; ind++ ) {") w2() w2("out[ind] = ", name, "(x, weights, n, N, ind );") w1("}") w1() w1("return out;") w1() w("}") w() ## function definition -- matrix w("// [[Rcpp::export]]") w( "NumericMatrix ", name, "_matrix( NumericMatrix A, int n, bool by_column, NumericVector weights ) {" ) w1() w1("int nRow = A.nrow();") w1("int nCol = A.ncol();") w1("int N = sum( sign( weights*weights ) );") ## by column w1("if( by_column ) {") w2() w2("NumericMatrix B( nRow - n + 1, nCol );") w2() w2("for( int j=0; j < nCol; j++ ) {") w3() w3("NumericVector tmp = A(_, j);") w3("for( int ind=0; ind < nRow - n + 1; ind++ ) {") w4() w4("B(ind, j) = ", name, "( tmp, weights, n, N, ind );") w3("}") w2("}") w2() w1("return B;") w1() ## by row w1("} else {") w2() w2("NumericMatrix B( nRow, nCol - n + 1 );") w2() w2("for( int i=0; i < nRow; i++ ) {") w3() w3("NumericVector tmp = A(i, _);") w3("for( int ind=0; ind < nCol - n + 1; ind++ ) {") w4() w4("B(i, ind) = ", name, "( tmp, weights, n, N, ind );") w3("}") w2("}") w2() w1("return B;") w1() w1("}") w() w("}") cat("C++ source file written to", outFile, ".\n") cat("Compiling...\n") sourceCpp(outFile, env = cpp_env, ...) cat("Done!\n") return(function(x, n, by.column = TRUE, weights = rep(1,n), normalize = FALSE) { force(combine) force(outFile) if (length(weights) != n) { stop("length of weights must equal n") } if (normalize) { weights <- weights * length(weights) / sum(weights) } if (is.matrix(x)) { if (n > nrow(x)) { stop("n cannot be greater than nrow(x)") } call <- call( paste(sep = "", name, "_matrix"), x, as.integer(n), as.logical(by.column), as.numeric(weights) ) return(eval(call, envir = cpp_env)) } if (is.vector(x)) { if (n > length(x)) { stop("n cannot be greater than length(x)") } call <- call(paste(sep = "", name, "_numeric"), x, as.integer(n), as.numeric(weights)) return(as.numeric(eval(call, envir = cpp_env))) } stop("the x supplied is neither a vector nor a matrix") }) } RcppRoll/R/rollit_example.R0000644000176200001440000000200312510060324015337 0ustar liggesusers#' 'rollit' Output -- Example Function #' #' This presents the function signature for the output of #' \code{\link{rollit}}. #' #' @param x A vector/matrix of numeric type. #' @param n integer; the window / subset size to roll over. #' @param by.column boolean; if \code{TRUE} we loop over columns, #' otherwise we loop over rows. #' @param weights a vector of length \code{n}; specify the weighting #' to assign to each element in the window. #' @param normalize boolean; if \code{TRUE} we normalize the weights to #' sum to 1. #' @return This function does not return anything; it merely exists #' as a skeleton to provide documentation for your own \code{rollit} #' generated functions. #' @note Elements in \code{weights} equal to 0 are skipped, so that e.g. #' setting \code{weights = c(1,0,1,0,1)} would skip every 2nd and 4th #' element in each length-5 window. #' @seealso \code{\link{rollit}} rollit_example <- function(x, n, by.column, weights, normalize=FALSE) { return( invisible(NULL) ) }RcppRoll/README.md0000644000176200001440000000051712457034422013274 0ustar liggesusersRcppRoll ===== This package provides an interface for commonly-used math and statistical functions as 'rollers', and also provides a utility function, 'rollit', for generating your own fast, C++ backed rollers. Install me with devtools: install_github("kevinushey/RcppRoll") and check some examples with example(rollit) RcppRoll/MD50000644000176200001440000000163312510070772012323 0ustar liggesusers48adc312a28fc541d28ff844a735b3e0 *DESCRIPTION 2e21824c9f835e1c7437e262b21f7f5c *NAMESPACE 80e73841e786ff2f4d13ba1a93c6731a *R/RcppExports.R 534b313199a336434db15690648c98f6 *R/RcppRoll-package.R 1a0efbbbddf9624885742d8b42a44ed7 *R/get_rollit_source.R a7790e11170b45469ee7b74773a1f471 *R/rollit.R 15c88e171d3df05a006be518fa4f512f *R/rollit_example.R 5b176238ae06c1b3d72b8aeb557e7300 *R/rollit_generated.R 8f8190be5994d92811797c73b317cfa6 *R/rollit_raw.R 4b98b5e4c44314bb2137bc52a4cad82f *README.md f7a3dc1989a63e43439f948e213aae68 *man/RcppRoll-exports.Rd decd87b6ab6c906d152d3fb03ab03a38 *man/RcppRoll.Rd 99d7fcfb2b28c890649fef6975591bf0 *man/get_rollit_source.Rd 83221b78a4a547e6a38f91271b1c71e0 *man/rollit.Rd f5e9db3eeea2c3c2c9c9f667943d6ffb *man/rollit_example.Rd a228f3f14f318b593adbd6c85cd6c0bb *man/rollit_raw.Rd 1f95107e155bccc0fbf3f191605ec550 *src/RcppExports.cpp bdc7aa288c74b154c65e658556b30143 *src/rollit.cpp RcppRoll/DESCRIPTION0000644000176200001440000000125012510070772013514 0ustar liggesusersPackage: RcppRoll Type: Package Title: Efficient Rolling / Windowed Operations Version: 0.2.2 Date: 2015-04-04 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, microbenchmark, testthat, RcppArmadillo Imports: Rcpp LinkingTo: Rcpp NeedsCompilation: yes Packaged: 2015-04-04 23:07:51 UTC; kevinushey Repository: CRAN Date/Publication: 2015-04-05 01:21:30 RcppRoll/man/0000755000176200001440000000000012457034422012565 5ustar liggesusersRcppRoll/man/get_rollit_source.Rd0000644000176200001440000000133112510057554016577 0ustar liggesusers% Generated by roxygen2 (4.1.0): do not edit by hand % Please edit documentation in R/get_rollit_source.R \name{get_rollit_source} \alias{get_rollit_source} \title{Get and Edit Source File Associated with User-Generated 'rollit' Function} \usage{ get_rollit_source(fun, edit = TRUE, RStudio = FALSE, ...) } \arguments{ \item{fun}{The generated 'rollit' function.} \item{edit}{boolean; open the C++ source file in a text editor?} \item{RStudio}{boolean; open the C++ source file in RStudio?} \item{...}{Optional arguments passed to \code{\link{file.edit}}.} } \description{ This function returns and opens the source file associated with a particular 'rollit' function for debugging. We use \R's \code{file.edit} interface. } RcppRoll/man/rollit.Rd0000644000176200001440000001064112510057554014364 0ustar liggesusers% Generated by roxygen2 (4.1.0): do not edit by hand % Please edit documentation in R/rollit.R \name{rollit} \alias{rollit} \title{Generate your own Weighted C++ Roll Function} \usage{ rollit(fun = "x", vector = FALSE, const_vars = NULL, combine = "+", final_trans = NULL, includes = NULL, depends = NULL, inline = TRUE, name = NULL, ...) } \arguments{ \item{fun}{A character string defining the function call. The function must be in terms of \code{x}. The function will be applied individually to each element being 'roll'ed over, unless \code{vector} is \code{TRUE}.} \item{vector}{boolean; if \code{TRUE}, then \code{fun} is a scalar-valued function of a vector, rather than a function to apply to each element individually.} \item{const_vars}{Constant variables that will live within the sourced C++ function. Format is a named \code{list}; e.g, you could pass \code{list(e=exp(1))} to have \code{e} as a constant variable available in the function being called. Note that the variable \code{N} is fixed to be the number of non-zero weights passed, to facilitate the use of \code{0} weights in terms of skipping elements.} \item{combine}{character; typically one of \code{"+", "-", "*", "/"}, but any operator usable as a C++ compound assignment operator is accepted. This specifies how each element should be combined in the rolling function. Only used when \code{vector} is \code{FALSE}.} \item{final_trans}{A final transformation to perform after either 'rolling' over each element in the vector \code{x} (with \code{vector=FALSE}), or after applying a scalar-valued function of a vector (with \code{vector=TRUE}). Must be in terms of \code{x}.} \item{includes}{Other C++ libraries to include. For example, to include \code{boost/math.hpp}, you would pass \code{c("")}.} \item{depends}{Other libraries to link to. Linking is done through Rcpp attributes.} \item{inline}{boolean; mark the function generated as \code{inline}? This may or may not increase execution speed.} \item{name}{string; a name to internally assign to your generated C++ functions.} \item{...}{Additional arguments passed to \code{sourceCpp}.} } \value{ A wrapper \R function that calls compiled C++ files, as generated through \code{sourceCpp}. See \code{\link{rollit_example}} for more information on the functions generated by \code{rollit}. } \description{ Using this interface, you can define a function that you would like to be called on each sub-vector you are rolling over. The generated code is compiled and exposed via \code{sourceCpp}. } \details{ By default, we include \code{} in each file; however, you can include your own libraries with the \code{includes} call. } \note{ All functions generated use Rcpp's \code{NumericVector} and \code{NumericMatrix} to interface with \R vectors and matrices. Elements within these vectors are translated as \code{double}s so any function that receives a \code{double} will work fine. If you want to just write your own C++ function to wrap into a 'rolling' interface, see \code{\link{rollit_raw}}. } \examples{ \dontrun{ x <- matrix(1:16, nrow=4) ## the squared rolling sum -- we square the sum of our rolled results rolling_sqsum <- rollit( final_trans="x*x" ) rolling_sqsum( x, 4 ) rolling_sqsum( x, 4, by.column=FALSE ) cbind( as.vector(rolling_sqsum(x, 4)), apply(x, 2, function(x) { sum(x)^2 } ) ) ## implement your own variance function ## we can use the sugar function 'mean' to get ## the mean of x const_vars <- list(m = "mean(x)") var_fun <- "( (x-m) * (x-m) )/(N-1)" rolling_var <- rollit( var_fun, const_vars=const_vars ) x <- c(1, 5, 10, 15) cbind( rolling_var(x, 2), roll_var(x, 2) ) ## use a function from cmath rolling_log10 <- rollit( "log10(x)" ) rolling_log10( 10^(1:5), 2 ) ## rolling product rolling_prod <- rollit( combine="*" ) rolling_prod( 1:10, 2 ) ## using weights to specify something like a 'by' argument rolling_prod( 1:10, 3, weights=c(1,0,1) ) ## a benchmark if( require("microbenchmark") && require("zoo") ) { x <- rnorm(1E4) microbenchmark( rolling_var(x, 100), roll_var(x, 100), rollapply(x, 100, var), times=10 ) }} } \seealso{ \code{\link{rollit_example}} for an example of the function signature for functions generated with \code{rollit}, \code{\link{sourceCpp}} for information on how Rcpp compiles your functions, \code{\link{get_rollit_source}} for inspection of the generated C++ code, and \code{\link{rollit_raw}} for wrapping in your own C++ code. } RcppRoll/man/rollit_raw.Rd0000644000176200001440000000516412510057554015241 0ustar liggesusers% Generated by roxygen2 (4.1.0): do not edit by hand % Please edit documentation in R/rollit_raw.R \name{rollit_raw} \alias{rollit_raw} \title{Generate your own Weighted C++ Roll Function} \usage{ rollit_raw(fun, depends = NULL, includes = NULL, inline = TRUE, name = NULL, additional = NULL, ...) } \arguments{ \item{fun}{A character string defining the function call. See examples for usage.} \item{depends}{Other libraries to link to. Linking is done through Rcpp attributes.} \item{includes}{Other C++ libraries to include. For example, to include \code{boost/math.hpp}, you would pass \code{c("")}.} \item{inline}{boolean; mark this function as inline? This may or may not increase execution speed.} \item{name}{string; a name to internally assign to your generated C++ functions.} \item{additional}{Other C++ code you want to include; e.g. helper functions. This code will be inserted as-is above the code in \code{fun}.} \item{...}{Optional arguments passed to \code{sourceCpp}.} } \description{ Using this, you can write and wrap in your own C++ function. } \details{ The signature of \code{fun} is fixed as: \code{double ( NumericVector& x, NumericVector& weights, const int& n, const int& N, const int& ind)} where \itemize{ \item{\code{X_SUB} is a \code{#define} macro that expands to the sub-vector being rolled over,} \item{\code{X(i)} is a \code{#define} macro that expands to the current element of \code{X_SUB} in a loop being rolled over,} \item{\code{x} is a reference to the \bold{entire} vector (not just the sub-vector being rolled over),} \item{\code{weights} are the weights,} \item{\code{n} is the window size,} \item{\code{N} is the number of non-zero \code{weights} passed,} \item{\code{ind} is the current position along vector \code{x}.} } Because the variables are being passed by reference, you should \bold{not} modify them, unless you're prepared for strange behavior. See examples for a potential usage. } \examples{ \dontrun{ ## implement a weighted rolling 'sum of squares' fun <- " double out = 0; const double m = mean( X_SUB ); for( int i=0; i < n; i++ ) { out += weights[i] * ( (X(i)-m) * (X(i)-m) ) / (N-1); } return out; " rolling_var <- rollit_raw( fun ) x <- 1:5 rolling_var( x, 5 ) == var(x) ## a (slow-ish) implementation of rolling kurtosis fun <- " double numerator = 0; double denominator = 0; const double m = mean( X_SUB ); for( int i=0; i < n; i++ ) { double tmp = ( X(i) - m ) * ( X(i) - m ); numerator += tmp * tmp; denominator += tmp; } return N * numerator / ( denominator * denominator ); " rolling_kurt <- rollit_raw( fun ) x <- rnorm(100) rolling_kurt(x, 20) } } RcppRoll/man/RcppRoll.Rd0000644000176200001440000000126512510061167014611 0ustar liggesusers% Generated by roxygen2 (4.1.0): 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}}} } } \seealso{ \code{\link{rollit}} for 'roll'-ing your own custom functions. } RcppRoll/man/RcppRoll-exports.Rd0000644000176200001440000001164612510063040016307 0ustar liggesusers% Generated by roxygen2 (4.1.0): do not edit by hand % Please edit documentation in R/rollit_generated.R \name{RcppRoll-exports} \alias{RcppRoll-exports} \alias{roll_max} \alias{roll_maxl} \alias{roll_maxr} \alias{roll_mean} \alias{roll_meanl} \alias{roll_meanr} \alias{roll_median} \alias{roll_medianl} \alias{roll_medianr} \alias{roll_min} \alias{roll_minl} \alias{roll_minr} \alias{roll_prod} \alias{roll_prodl} \alias{roll_prodr} \alias{roll_sd} \alias{roll_sdl} \alias{roll_sdr} \alias{roll_sum} \alias{roll_suml} \alias{roll_sumr} \alias{roll_var} \alias{roll_varl} \alias{roll_varr} \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{"middle"} 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 supply \strong{l}eft and \strong{r}ight alignment of the windowed operations. } RcppRoll/man/rollit_example.Rd0000644000176200001440000000213412510057554016075 0ustar liggesusers% Generated by roxygen2 (4.1.0): do not edit by hand % Please edit documentation in R/rollit_example.R \name{rollit_example} \alias{rollit_example} \title{'rollit' Output -- Example Function} \usage{ rollit_example(x, n, by.column, weights, normalize = FALSE) } \arguments{ \item{x}{A vector/matrix of numeric type.} \item{n}{integer; the window / subset size to roll over.} \item{by.column}{boolean; if \code{TRUE} we loop over columns, otherwise we loop over rows.} \item{weights}{a vector of length \code{n}; specify the weighting to assign to each element in the window.} \item{normalize}{boolean; if \code{TRUE} we normalize the weights to sum to 1.} } \value{ This function does not return anything; it merely exists as a skeleton to provide documentation for your own \code{rollit} generated functions. } \description{ This presents the function signature for the output of \code{\link{rollit}}. } \note{ Elements in \code{weights} equal to 0 are skipped, so that e.g. setting \code{weights = c(1,0,1,0,1)} would skip every 2nd and 4th element in each length-5 window. } \seealso{ \code{\link{rollit}} }