1

在 R 中，我正在构建一个矩阵M，为 20 轮游戏中的每一轮存储 4 个变化的权重。

我从权重向量 (4x1) 开始，以权重向量W1(4x1) 结束游戏W2。

权重值保持不变，直到更改启动轮C1(=5)。

在一轮之后C1，权重开始以相等的增量w2c和w3c超过C(=10) 轮变化。

权重必须始终添加到1.

我使用for循环来构建矩阵M。结果如下所示： 

      [,1] [,2] [,3] [,4]
 [1,] 0.30 0.50 0.10 0.10
 [2,] 0.30 0.50 0.10 0.10
 [3,] 0.30 0.50 0.10 0.10
 [4,] 0.30 0.50 0.10 0.10
 [5,] 0.30 0.50 0.10 0.10
 [6,] 0.28 0.46 0.12 0.14
 [7,] 0.26 0.42 0.14 0.18
 [8,] 0.24 0.38 0.16 0.22
 [9,] 0.22 0.34 0.18 0.26
[10,] 0.20 0.30 0.20 0.30
[11,] 0.18 0.26 0.22 0.34
[12,] 0.16 0.22 0.24 0.38
[13,] 0.14 0.18 0.26 0.42
[14,] 0.12 0.14 0.28 0.46
[15,] 0.10 0.10 0.30 0.50
[16,] 0.10 0.10 0.30 0.50
[17,] 0.10 0.10 0.30 0.50
[18,] 0.10 0.10 0.30 0.50
[19,] 0.10 0.10 0.30 0.50
[20,] 0.10 0.10 0.30 0.50

这是我的 R 代码：

输入：

N=4 # 4 number of weights
R=20 #rounds
M <- matrix(0, ncol=N, nrow=R) 
C=10 # change duration in rounds
C1=5 # round at which change starts
C2=C1+C # round at which change ends
w1=0.1 #small weight
w2=0.3 #average weight
w3=0.5 #large weight
w2c=(w2-w1)/C #change increment for average weight mutation
w3c=(w3-w1)/C #change increment for large weight mutation
W1<-c(w2, w3, w1, w1) #starting weight vector
W2<-c(w1, w1, w2, w3) #ending weight vector

For循环，构建矩阵M：

for(n in 1:N){
  M[,n]<-W1[n]
  for(r in 1:R) {
    if(r>=C2){M[r,n] <- W2[n]}
  }
}

for(r in C1:(C2-1)) {
  T<-r-C1;
  M[r,1] =  M[r,1]-w2c*T;
  M[r,2] =  M[r,2]-w3c*T;
  M[r,3] =  M[r,3]+w2c*T;
  M[r,4] =  M[r,4]+w3c*T;
}
M

有没有更有效的方法可以在没有for循环的情况下实现相同的结果？

4

2 回答 2

2

分别填充顶部、中间和底部的三个调用：

M[1:C1,  ] <- rep(W1, each = C1)
M[C1:C2, ] <- mapply(seq, from = W1, to = W2, length = C2 - C1 + 1)
M[C2:R,  ] <- rep(W2, each = R - C2 + 1)

如果您像我一样喜欢非常对称（或一致）的代码，您可以概括并说顶部和底部就像中间的部分：它们分别线性地W1来回移动W1。因此：W2W2

M[1:C1,  ] <- mapply(seq, from = W1, to = W1, length = C1 -  1 + 1)
M[C1:C2, ] <- mapply(seq, from = W1, to = W2, length = C2 - C1 + 1)
M[C2:R,  ] <- mapply(seq, from = W2, to = W2, length =  R - C2 + 1)
于 2014-12-09T00:56:57.547 回答
2

您可以将权重乘以更改时间步数，然后将这些向量添加到更改前的值（例如，使用sweep）。

x <- rbind(c(0.30, 0.50, 0.10, 0.10))
M <- rbind(x[rep(1, C1), ],
           sweep( sapply(c(-w2c, -w3c, w2c, w3c), '*', seq_len(C)),
                    2, x, '+'))
M <- rbind(M, M[ nrow(M), , drop=FALSE][ rep(1, R-C1-C), ])

#       [,1] [,2] [,3] [,4]
#  [1,] 0.30 0.50 0.10 0.10
#  [2,] 0.30 0.50 0.10 0.10
#  [3,] 0.30 0.50 0.10 0.10
#  [4,] 0.30 0.50 0.10 0.10
#  [5,] 0.30 0.50 0.10 0.10
#  [6,] 0.28 0.46 0.12 0.14
#  [7,] 0.26 0.42 0.14 0.18
#  [8,] 0.24 0.38 0.16 0.22
#  [9,] 0.22 0.34 0.18 0.26
# [10,] 0.20 0.30 0.20 0.30
# [11,] 0.18 0.26 0.22 0.34
# [12,] 0.16 0.22 0.24 0.38
# [13,] 0.14 0.18 0.26 0.42
# [14,] 0.12 0.14 0.28 0.46
# [15,] 0.10 0.10 0.30 0.50
# [16,] 0.10 0.10 0.30 0.50
# [17,] 0.10 0.10 0.30 0.50
# [18,] 0.10 0.10 0.30 0.50
# [19,] 0.10 0.10 0.30 0.50
# [20,] 0.10 0.10 0.30 0.50
于 2014-12-08T19:01:46.887 回答