I am attempting to produce a piece of code that is similar to functions such as rollapply from zoo/xts but applicable to my needs. I produced the code using some very simple sample data and everything has worked fine. But now that I attempt to run it on the edhec data I am receiving an error. I am unclear why but assume it is something to do with the if statement. Is anyone able to diagnose why I am receiving the error?
#rm(list=ls()) #Clear environment
cat("\014") #CTRL + L
library(xts)
library(lubridate)
is.even <- function(x) x %% 2 == 0
roundUp <- function(x,to=2)
{
to*(x%/%to + as.logical(x%%to))
}
functionTest <- function(data, window, slide){
nyears_t = nyears(data)
#IF statement for non-even numbers only
if(is.even(nyears_t == FALSE)) {
nyears_t <- roundUp(nyears_t)
data_extend <- data
start_extend <- .indexyear(data)[length(data)]+ 1900 + 1
end_extend <- start_extend + length(data) - 1
index(data_extend) <- update(index(data),year=start_extend:end_extend)
data <- rbind(data, data_extend)
warning("WARNING! The function has looped to the start of the timeseries. The final list(s)
will contain years that do not exist in the dataset. Please modify.")
}
nslides = nyears_t/slide
#Matrix
year_1 = (.indexyear(data)[1]+1900)
start <- seq(from = year_1, by = slide, length.out = nslides)
end <- start + window - 1
mat <- matrix(c(start, end), ncol = 2, dimnames = list(c(1:nslides), c("start", "end")))
#For loop
subsetlist <- vector('list')
for(i in 1:nslides){
subset <- data[paste0(mat[i,1], "/", mat[i,2])]
subsetlist[[i]] <- subset
}
print(subsetlist)
}
Sample code that was used when I was making the function above:
a <- seq(from = as.POSIXct("2000", format = "%Y"), to = as.POSIXct("2008", format = "%Y"), by = "year")
a <- as.xts(1:length(a), order.by = a)
a
functionTest(data = a, window = 3, slide = 2)
Sample code I am testing on and receiving an error:
> data(edhec, package = "PerformanceAnalytics")
> edhec <- edhec[,1:3]
> edhec <- edhec["/2007"]
> head(edhec)
Convertible Arbitrage CTA Global Distressed Securities
1997-01-31 0.0119 0.0393 0.0178
1997-02-28 0.0123 0.0298 0.0122
1997-03-31 0.0078 -0.0021 -0.0012
1997-04-30 0.0086 -0.0170 0.0030
1997-05-31 0.0156 -0.0015 0.0233
1997-06-30 0.0212 0.0085 0.0217
> functionTest(data = edhec, window = 3, slide = 2)
Show Traceback
Rerun with Debug
Error in start_extend:end_extend : NA/NaN argument
>
UPDATE:
The code now runs with the following updates to the if statement (with thanks to Joshua Ulrich) (see code below). However, there is still a problem with the if statement - it appears to run regardless of whether there are an even or odd number of years present in the dataset. Although this does not impact the accuracy of the function, it may become problematic as large datasets are considered. If anyone has any thoughts on this it would be much appreciated. Otherwise this has been super already! Cheers
if(is.even(nyears_t == FALSE)) {
nyears_t <- roundUp(nyears_t)
data_extend <- data
start_extend <- .indexyear(data)[nrow(data)] + 1900 + 1
end_extend <- start_extend + nyears(data) - 1
dates <- index(data)
tmp <- as.POSIXlt(dates)
tmp$year <- tmp$year + nyears(data)
dates2 <- as.POSIXct(tmp, tz = tz)
index(data_extend) <- dates2
data <- rbind(data, data_extend)
warning("WARNING! The function has looped to the start of the timeseries. The final list(s)
will contain years that do not exist in the dataset. Please modify.")
}
Calling length on a matrix (which is what the coredata of xts/zoo objects is) gives you the total number of elements (i.e. the length of the underlying vector). You should use nrow instead.
start_extend <- .indexyear(data)[nrow(data)] + 1900 + 1
end_extend <- start_extend + nrow(data) - 1
If you're not sure whether data will be a matrix or a vector, then you should use NROW instead of nrow. Calling nrow on a vector returns NULL and NROW will return length(x) if x is a vector.
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With