Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

If statement error / not applying if statement

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.")
  }
like image 598
Quinn Avatar asked Jun 01 '26 21:06

Quinn


1 Answers

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.

like image 168
Joshua Ulrich Avatar answered Jun 03 '26 15:06

Joshua Ulrich