r-loops-`*tmp*` 下标越界

Question

我正在使用 slove.QP 解决二次问题（资产分配问题）。我对不同的预期回报范围有四个限制。例如，对于从 6.1 到 6.5 的返回范围，我对这个范围进行了约束，对于从 6.6 到 7.0 的范围，我对其进行了另一个约束，等等。

我创建了一个约束矩阵，它看起来像这样：

min max min max min max min max
..  ..  ..  ..  ..  ..  ..  ..
..  ..  ..  ..  ..  ..  ..  ..
..  ..  ..  ..  ..  ..  ..  ..
..  ..  ..  ..  ..  ..  ..  ..
......

循环中的mincons包含约束矩阵的所有最小列，maxcons包含约束矩阵的所有最大列。

例如，对于第一个循环，预期返回范围从 6.1 到 7.0，我在 solve.QP 函数中使用 mincons[,1] 和 maxcons[,1] 作为约束。同样的事情适用于接下来的三个循环。

但是 R 一直给我“下标越界”错误。我已经在 stackoverflow 上阅读了一些类似的问题，但我仍然无法弄清楚为什么会遇到此错误。任何人都可以帮助我。谢谢。

You can download dataconstraints.csv and datacorrelations.csv at 
https://www.dropbox.com/s/6bosunahysdfpcj/dataconstraints.csv
https://www.dropbox.com/s/vb94obm83lttdej/datacorrelations.csv

library(quadprog)

mydata = read.csv("dataconstraints.csv") 
er <- matrix(mydata[,1], nrow=23, ncol=1)
stdevs <- matrix(mydata[,2], nrow=23, ncol=1) 
min <- mydata[,c(FALSE, FALSE, TRUE, FALSE, TRUE, FALSE, TRUE, FALSE, TRUE, FALSE)]
mincons <- as.matrix(sapply(min, as.numeric))
max <- -mydata[,c(FALSE, FALSE, FALSE, TRUE, FALSE, TRUE, FALSE, TRUE, FALSE, TRUE)]
maxcons <- as.matrix(sapply(max, as.numeric))

mycorr = read.csv("datacorrelations.csv")
correlation <- mycorr
b <- stdevs %*% t(stdevs)  
covariance <- b * correlation

dvec <- er
Dmat <- as.matrix(sapply(covariance, as.numeric))

A.Equality <- matrix(c(1), nrow=length(er), ncol=1)
Amat <- cbind(A.Equality, er, diag(length(er)),-diag(length(er)))

port_ret1 = NULL
bvec1 = matrix(data=NA, nrow=5, ncol=48)
w1 = matrix(data=NA, nrow=5, ncol=23)
sd1 = matrix(data=NA, nrow=5, ncol=1)
ret1 = matrix(data=NA, nrow=5, ncol=1)

port_ret2 = NULL
bvec2 = matrix(data=NA, nrow=5, ncol=48)
w2 = matrix(data=NA, nrow=5, ncol=23)
sd2 = matrix(data=NA, nrow=5, ncol=1)
ret2 = matrix(data=NA, nrow=5, ncol=1)

port_ret3 = NULL
bvec3 = matrix(data=NA, nrow=5, ncol=48)
w3 = matrix(data=NA, nrow=5, ncol=23)
sd3 = matrix(data=NA, nrow=5, ncol=1)
ret3 = matrix(data=NA, nrow=5, ncol=1)

port_ret4 = NULL
bvec4 = matrix(data=NA, nrow=5, ncol=48)
w4 = matrix(data=NA, nrow=5, ncol=23)
sd4 = matrix(data=NA, nrow=5, ncol=1)
ret4 = matrix(data=NA, nrow=5, ncol=1)

n <- (8.0-6.1)/0.1+1

for(i in 1:n){

  if(i>=1 & i<=5){
    port_ret1[i]<-6.1+0.1*(i-1)
    bvec1[i,] <- c(1, port_ret1[i], mincons[,1], maxcons[,1])
    w1[i,] <- solve.QP(Dmat, dvec, Amat, bvec1[i,], meq=1)$solution
    sd1[i,] <- sqrt(w1[i,] %*% Dmat %*% w1[i,])
    ret1[i,] <- w1[i,] %*% er
  }

  if(i>=6 & i<=10){
    port_ret2[i]<-6.1+0.1*(i-1)
    bvec2[i,] <- c(1, port_ret2[i], mincons[,2], maxcons[,2])
    w2[i,] <- solve.QP(Dmat, dvec, Amat, bvec2[i,], meq=1)$solution
    sd2[i,] <- sqrt(w2[i,] %*% Dmat %*% w2[i,])
    ret2[i,] <- w2[i,] %*% er
  }

  if(i>=11 & i<=15){
    port_ret3[i]<-6.1+0.1*(i-1)
    bvec3[i,] <- c(1, port_ret3[i], mincons[,3], maxcons[,3])
    w3[i,] <- solve.QP(Dmat, dvec, Amat, bvec3[i,], meq=1)$solution
    sd3[i,] <- sqrt(w3[i,] %*% Dmat %*% w3[i,])
    ret3[i,] <- w3[i,] %*% er
  }

  if(i>=16 & i<=20){
    port_ret4[i]<-6.1+0.1*(i-1)
    bvec4[i,] <- c(1, port_ret4[i], mincons[,4], maxcons[,4])
    w4[i,] <- solve.QP(Dmat, dvec, Amat, bvec4[i,], meq=1)$solution
    sd4[i,] <- sqrt(w4[i,] %*% Dmat %*% w4[i,])
    ret4[i,] <- w4[i,] %*% er
  }
}


Error in `[<-`(`*tmp*`, i, , value = c(1, 6.6, 0, 0, 0, 0, 0, 0, 0, 0,  : 
  subscript out of bounds

error 看起来像这样，所以我猜第二个 if 语句越界了。如果我只运行第一个 if 语句，它运行正常，没有错误。我只是看不到任何越界的问题。

Answer 1

好的，您的代码相当长，所以我没有通读并尝试理解其背后的概念，但我对您的 for 循环的内容进行了一些调整，它可以正常执行。问题是您的每个子组port_ret1 到port_ret4、bvec1 到bvec4 等等...的索引长度都为5，而您试图使用i = 1:20（因为n=20 ) 来索引其中的值。这对第一组来说很好——port_ret1, bvec1, ...，但是当你到达i=6时，你不能做port_ret2[i] <- some value，因为port_ret2[6]不存在；即下标超出范围。所以我基本上只是在每个后​​续组中将i 向后移动了适当的数量（仅在它用作索引的地方，例如不在<-6.1+0.1*(i-1) 中）：

for(i in 1:n){
  ##
  if( i <= 5){

    port_ret1[i]<-6.1+0.1*(i-1)
    bvec1[i,] <- c(1, port_ret1[i], mincons[,1], maxcons[,1])
    w1[i,] <- solve.QP(Dmat, dvec, Amat, bvec1[i,], meq=1)$solution
    sd1[i,] <- sqrt(w1[i,] %*% Dmat %*% w1[i,])
    ret1[i,] <- w1[i,] %*% er
  } else if( i <= 10 ){

    port_ret2[i-5]<-6.1+0.1*(i-1)
    bvec2[i-5,] <- c(1, port_ret2[i-5], mincons[,2], maxcons[,2])
    w2[i-5,] <- solve.QP(Dmat, dvec, Amat, bvec2[i-5,], meq=1)$solution
    sd2[i-5,] <- sqrt(w2[i-5,] %*% Dmat %*% w2[i-5,])
    ret2[i-5,] <- w2[i-5,] %*% er
  } else if( i <= 15 ){

    port_ret3[i-10]<-6.1+0.1*(i-1)
    bvec3[i-10,] <- c(1, port_ret3[i-10], mincons[,3], maxcons[,3])
    w3[i-10,] <- solve.QP(Dmat, dvec, Amat, bvec3[i-10,], meq=1)$solution
    sd3[i-10,] <- sqrt(w3[i-10,] %*% Dmat %*% w3[i-10,])
    ret3[i-10,] <- w3[i-10,] %*% er
  } else {

    port_ret4[i-15]<-6.1+0.1*(i-1)
    bvec4[i-15,] <- c(1, port_ret4[i-15], mincons[,4], maxcons[,4])
    w4[i-15,] <- solve.QP(Dmat, dvec, Amat, bvec4[i-15,], meq=1)$solution
    sd4[i-15,] <- sqrt(w4[i-15,] %*% Dmat %*% w4[i-15,])
    ret4[i-15,] <- w4[i-15,] %*% er
  }
  ##
}

此外，您应该使用if...else if...else 语句，而不是将带有冗余条件检查的独立if 语句链接在一起。例如，在第二个语句中，您不必检查if(i >= 6 & i <= 10)，因为当且仅当 i >= 6（因为您的第一个if(i <= 5) 条件）才会达到此条件。无论如何，这确实执行没有错误，但就像我说的，我没有花时间从概念上理解它正在完成的任务，所以如果有其他需要调整的地方，请告诉我。