diff --git a/R/toperiod.R b/R/toperiod.R index cd5a5edd..ec4ea10e 100644 --- a/R/toperiod.R +++ b/R/toperiod.R @@ -44,8 +44,31 @@ to.period <- to_period <- function(x, period='months', k=1, indexAt=NULL, name=N warning("missing values removed from data") } + if(is.character(period)) { + ep <- endpoints(x, period, k) + } else { + if(!is.numeric(period)) { + stop("'period' must be a character or a vector of endpoint locations") + } + if(!missing("k")) { + warning("'k' is ignored when using custom 'period' locations") + } + if(!is.null(indexAt)) { + warning("'indexAt' is ignored when using custom 'period' locations") + indexAt <- NULL + } + ep <- as.integer(period) + # ensure 'ep' starts with 0 and ends with nrow(x) + if(ep[1] != 0) { + ep <- c(0L, ep) + } + if (ep[length(ep)] != NROW(x)) { + ep <- c(ep, NROW(x)) + } + } + if(!OHLC) { - xx <- x[endpoints(x, period, k),] + xx <- x[ep, ] } else { if(!is.null(indexAt)) { index_at <- switch(indexAt, @@ -69,7 +92,7 @@ to.period <- to_period <- function(x, period='months', k=1, indexAt=NULL, name=N xx <- .Call(C_toPeriod, x, - endpoints(x, period, k), + ep, has.Vo(x), has.Vo(x,which=TRUE), has.Ad(x) && is.OHLC(x), index_at, diff --git a/inst/unitTests/runit.to.period.R b/inst/unitTests/runit.to.period.R index bce8fe1b..0bb5e90d 100644 --- a/inst/unitTests/runit.to.period.R +++ b/inst/unitTests/runit.to.period.R @@ -11,3 +11,23 @@ test.to.frequency_includes_first_group <- function() { checkIdentical(tf, tp) } +test.to.period_custom_endpoints <- function() { + data(sample_matrix) + x <- as.xts(sample_matrix) + + ep <- endpoints(x, "months", 1) + y1 <- to.period(x, "months", 1) + y2 <- to.period(x, ep) + + checkIdentical(y1, y2) + + # period must be character or numeric + checkException(to.period(x, TRUE)) + + # 'k' and 'indexAt' are ignored + op <- options(warn = 2) + on.exit(options(warn = op$warn)) + checkException(to.period(x, ep, k = 2)) + checkException(to.period(x, ep, indexAt = "")) +} +