From e66e275414518077f9e5af386e7e5bdfbea8a5db Mon Sep 17 00:00:00 2001
From: Joshua Ulrich <josh.m.ulrich@gmail.com>
Date: Thu, 13 Oct 2022 15:48:28 -0500
Subject: [PATCH] Allow custom endpoints for to.period()

This allows users to provide a custom set of endpoints via the 'period'
argument, so they can aggregate on something other than 'endpoints()'
time.

Thanks to Ethan B. Smith for the suggestion!

Fixes #302.
---
 R/toperiod.R                     | 27 +++++++++++++++++++++++++--
 inst/unitTests/runit.to.period.R | 20 ++++++++++++++++++++
 2 files changed, 45 insertions(+), 2 deletions(-)

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 = ""))
+}
+