명세서에 오류가있는 경우/적용되지 않음 문이 적용된 경우

Question

rollapply과 같은 기능 (예 : zoo/xts)과 유사한 기능을 제공하지만 내 요구 사항에 해당하는 코드를 생성하려고합니다. 아주 간단한 샘플 데이터를 사용하여 코드를 만들었고 모든 것이 잘 작동했습니다. 하지만 지금은 내가 오류가 발생했습니다 edhec 데이터에 그것을 실행하려고 시도합니다. 나는 왜 불분명 하나 그것이 if 문과 관련이 있다고 가정한다. 누구든지 왜 오류가 발생했는지 진단 할 수 있습니까?

#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) 
} 

내가 위의 기능을 때 사용 된

샘플 코드 :

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) 

I가 테스트하고 오류 수신하고 샘플 코드 :

> 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..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 :

를

이제 코드가 다음 업데이트와 함께 실행됩니다. if 문 (Joshua Ulrich에게 감사) (아래 코드 참조). 그러나 if 문에는 여전히 문제가 있습니다. 데이터 집합에 짝수 또는 홀수의 년이 있는지 여부에 관계없이 실행되는 것처럼 보입니다. 이 기능의 정확성에는 영향을 미치지 않지만 대용량 데이터 집합을 고려하면 문제가 될 수 있습니다. 누구든지 이것에 대해 어떤 생각을 가지고 있다면 많은 도움이 될 것입니다. 그렇지 않으면 이것은 이미 슈퍼되었습니다! (XTS/동물원 개체 coredata이 바로 이것이다)에게 요소의 총 개수 (기본 벡터의 길이 즉,)를 제공하는 행렬에 length 호출 건배

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.") 
    } 

Answer 1

. 대신 nrow을 사용해야합니다. 당신이 data이 행렬 또는 벡터를 할 것인지 확실하지 않으면

start_extend <- .indexyear(data)[nrow(data)] + 1900 + 1 
end_extend <- start_extend + nrow(data) - 1 

, 당신은 NROW 대신 nrow 사용해야합니다. 벡터에 nrow을 호출하면 및 NROW이 반환됩니다. x이 벡터 인 경우 length(x)을 반환합니다.

Answer 2

나는 지금 원하는 효과가있는 완전한 대답을 생각해 냈습니다. 도움을 주신 @ Joshua에게 감사드립니다. - 제가 그것없이 코드를 고칠 수 있다고 생각하지 않습니다. 큰 데이터에서 실행하기 위해 몇 가지 추가 변경 작업을 수행해야했습니다. 관심 위해서

, 이쪽은 내 전체 작업 코드 (마이너스 내 추가로 사용자 정의 함수)입니다 :

data(edhec, package = "PerformanceAnalytics") 
edhec <- edhec[,1:3] 
edhec08 <- edhec["/2008"] 
edhec07 <- edhec["/2007"] 

bootOffset(data = edhec08, #EVEN 
        window = 4, 
        slide = 3) 

bootOffset(data = edhec07, #ODD 
        window = 4, 
        slide = 3) 

# 을 : 원하는대로 결과가 나올

bootOffset <- function(data, window, slide, tz = "GMT"){ 

    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)[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) 
    } 

    nslides = nyears_t/slide 

    year_1 = (.indexyear(data)[1] + 1900) 

    #Matrix 
    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 <- window(data, 
        start = as.POSIXct(paste0(mat[i,1], "-01-01")), 
        end = as.POSIXct(paste0(mat[i,2], "-12-31"))) 

    subsetlist[[i]] <- subset 
    } 
    print(subsetlist) 
} 

그리고 확인을 위해

> bootOffset.Check <- function(boot){ 
+ dates <- lapply(boot, year) 
+ dates <- lapply(dates, unique) 
+ dates <- lapply(dates, `length<-`, max(lengths(dates))) 
+ as.data.frame(dates, 
+ col.names = paste0("boot_", 1:length(boot))) 
+ 
+ } 
> 
> nyears(edhec08) 
[1] 12 
> bootOffset.Check(boot08) #EVEN number of years 
    boot_1 boot_2 boot_3 boot_4 
1 1997 2000 2003 2006 
2 1998 2001 2004 2007 
3 1999 2002 2005 2008 
4 2000 2003 2006  NA 
> 
> nyears(edhec07) 
[1] 11 
> bootOffset.Check(boot07) #ODD number of years 
    boot_1 boot_2 boot_3 boot_4 
1 1997 2000 2003 2006 
2 1998 2001 2004 2007 
3 1999 2002 2005 2008 
4 2000 2003 2006 2009 
>