tseries - 塊引導兩個系列相同的重采樣順序

Question

例如

    require(tseries)
    series1 <- c(100,140,150,200,150,260,267,280,300,350)
    series2 <- c(500,600,250,300,350,500,100,130,50,60)
    data <- data.frame("series1" = series1, "series2" = series2)
ts  = tsbootstrap(data$series1, m=1, b=2, type="block", nb=10)
ts <- as.data.frame(ts)
head(ts)

> head(ts)
   V1  V2  V3  V4  V5  V6  V7  V8  V9 V10
1 280 280 150 200 100 300 150 140 100 260
2 300 300 200 150 140 350 260 150 140 267
3 140 260 140 260 267 200 150 150 260 300
4 150 267 150 267 280 150 200 200 267 350
5 260 100 260 150 300 100 150 267 100 200
6 267 140 267 200 350 140 260 280 140 150

我們現在有兩個塊，並以不同的順序拼接在一起。 我的問題是，如何通過塊 boostrap 來“重新洗牌” series1 和 series2，同時將兩個系列的塊保持在相同的順序？

例如..如果我們將塊設置為 2，它會抓取 2 個塊，可以說它的位置是 5,6 中的 10。它抓取元素 5,6 並將其移動到位置 1,2...這是對於系列 1，對於系列2，它抓住元素 5,6 並移動到位置 1,2。 這樣我保持兩個系列的相同順序，這可能嗎？

到目前為止，我已嘗試合並 series1 和 series2 以創建一個新列。 這樣，當使用 bootstrap 時，它會將兩個系列移動到相同的位置：

    data <- transform(data, ts.merge=paste(series1, series2, sep=","))
head(data)
  series1 series2 ts.merge
1     100     500  100,500
2     140     600  140,600
3     150     250  150,250
4     200     300  200,300
5     150     350  150,350
6     260     500  260,500

但是， , 分隔符與 tseries 不兼容...

Error in FUN(newX[, i], ...) : 
  NA/NaN/Inf in foreign function call (arg 1)
In addition: Warning messages:
1: In as.vector(x, mode = "double") : NAs introduced by coercion
2: In as.vector(x, mode = "double") : NAs introduced by coercion

但是，我也嘗試使用分隔符“”，但不確定之后如何區分兩個數值以便將它們分開（請注意，我的現實生活中的示例不僅僅是如上所示的三位數值，否則之后我可以將它們分成兩半）

Answer 1

花了我一整天，但這是一個手動解決方案，它將每行重新采樣：

    # Random Data
    data=matrix(rnorm(20*100), ncol = 2)
    data=as.data.frame(data)
    # Set block size
    reps <- NROW(data)/5 # Set group number
    data$id <- rep(1:reps,each=5) # each = 5 corresponds to number of blocks to bootstrap by (5 in this case)
    # Id data
    IDs<-unique(data$id)
    runs <- 1:1000
    temp <- list()
    # Function for bootstrap 1x data frame
    # subsets data by id number
    # Resamples the subsets
    bootSTRAP = function(x){
      for (i in 1:length(IDs)){ 
        temp[i] <- list(data[data$id==IDs[i],])
      }
      out <- sample(temp,replace=TRUE)
      df <- do.call(rbind, out)
    }

    # Loop for running it a 1000 times
    runs <- 1:1000
    run.output <- list()
    i=1
    for (i in 1:length(runs)){    # Length of optimization
      tryCatch({
        temp.1 <- bootSTRAP(runs[i])
        #cum_ret <- rbind.data.frame(cum_ret, temp)
        run.output[[i]] <- cbind.data.frame(temp.1)
        ptm0 <- proc.time()
        Sys.sleep(0.1)  
        ptm1=proc.time() - ptm0
        time=as.numeric(ptm1[3])
        cat('\n','Iteration',i,'took', time, "seconds to complete")
      }, error = function(e) { print(paste("i =", i, "failed:")) })
    }

# cbind outputs
master <- do.call(cbind, run.output)
# Rename columns 
col.ids <- rep(1:1000,each=3)
cnames   <- paste(col.ids)
colnames(master) <- cnames

Answer 2

如果目標是保持 series1 和 series2 行同步，您可以在創建“數據”時添加索引，如下所示：

data <- data.frame("series1" = series1, "series2" = series2, index = 
seq(1:length(series1))) 

然后將要引導的數據字段更改為“索引”，如下所示：

ts  = tsbootstrap(data$index, m=1, b=2, type="block", nb=10)

Answer 3

嘗試：

ts.index    = tsbootstrap(index(series1), m=1, b=2, type="block", nb=10)
series1[ts.index[,1]]
series2[ts.index[,1]]

接下來，您可以根據需要管理最終數據框。