我有一个很长的时间序列循环，我想简化/压缩。我试图使用随机二项分布模拟十年（每月间隔）牛群的产犊。该功能首先假设牛已经被公牛覆盖。每个变量都受前一个影响。变量如下：
G1：每个月G9妊娠。 MC1：MC7母亲用小牛犊7个月，然后小牛断奶。 休息1：在公牛再次被公牛覆盖之前休息6个休息时间。 DeadCows基于死亡率。 基于受孕率的NPreg非怀孕奶牛。
输入： size_cowherd，牛群中的牛数量。 概念，受孕率。
提前致谢。
我的代码如下：
size_cowherd<-100
concep<-0.95
cows <- function(t=119, mort=0.0005){
G1<- numeric(length = t + 1)
G2<- numeric(length = t + 1)
G3<- numeric(length = t + 1)
G4<- numeric(length = t + 1)
G5<- numeric(length = t + 1)
G6<- numeric(length = t + 1)
G7<- numeric(length = t + 1)
G8<- numeric(length = t + 1)
G9<- numeric(length = t + 1)
MC1<- numeric(length = t + 1)
MC2<- numeric(length = t + 1)
MC3<- numeric(length = t + 1)
MC4<- numeric(length = t + 1)
MC5<- numeric(length = t + 1)
MC6<- numeric(length = t + 1)
MC7<- numeric(length = t + 1)
Rest1<- numeric(length = t + 1)
Rest2<- numeric(length = t + 1)
Rest3<- numeric(length = t + 1)
Rest4<- numeric(length = t + 1)
Rest5<- numeric(length = t + 1)
Rest6<- numeric(length = t + 1)
DeadCows <- numeric(length = t + 1)
NPreg <- numeric(length = t + 1)
G1[1]<- rbinom(1,size_cowherd,concep)
G2[1]<- 0
G3[1]<- 0
G4[1]<- 0
G5[1]<- 0
G6[1]<- 0
G7[1]<- 0
G8[1]<- 0
G9[1]<- 0
MC1[1]<- 0
MC2[1]<- 0
MC3[1]<- 0
MC4[1]<- 0
MC5[1]<- 0
MC6[1]<- 0
MC7[1]<- 0
Rest1[1]<-0
Rest2[1]<-0
Rest3[1]<-0
Rest4[1]<-0
Rest5[1]<-0
Rest6[1]<-0
DeadCows[1] <- 0
NPreg[1] <- size_cowherd - G1[1]
for(step in 1:t){
G2[step+1] <- rbinom(1, G1[step], (1-mort))
G3[step+1] <- rbinom(1, G2[step], (1-mort))
G4[step+1] <- rbinom(1, G3[step], (1-mort))
G5[step+1] <- rbinom(1, G4[step], (1-mort))
G6[step+1] <- rbinom(1, G5[step], (1-mort))
G7[step+1] <- rbinom(1, G6[step], (1-mort))
G8[step+1] <- rbinom(1, G7[step], (1-mort))
G9[step+1] <- rbinom(1, G8[step], (1-mort))
MC1[step+1] <- rbinom(1, G9[step], (1-mort))
MC2[step+1] <- rbinom(1, MC1[step], (1-mort))
MC3[step+1] <- rbinom(1, MC2[step], (1-mort))
MC4[step+1] <- rbinom(1, MC3[step], (1-mort))
MC5[step+1] <- rbinom(1, MC4[step], (1-mort))
MC6[step+1] <- rbinom(1, MC5[step], (1-mort))
MC7[step+1] <- rbinom(1, MC6[step], (1-mort))
Rest1[step+1] <- rbinom(1,MC7[step],(1-mort))
Rest2[step+1] <- rbinom(1,Rest1[step],(1-mort))
Rest3[step+1] <- rbinom(1,Rest2[step],(1-mort))
Rest4[step+1] <- rbinom(1,Rest3[step],(1-mort))
Rest5[step+1] <- rbinom(1,Rest4[step],(1-mort))
Rest6[step+1] <- rbinom(1,Rest5[step],(1-mort))
G1[step+1] <- rbinom(1, Rest6[step], (1-mort))
DeadCows[step+1] <-sum(G1[step]-G2[step+1],G2[step]-G3[step+1],G3[step]-
G4[step+1],G4[step]-G5[step+1],G5[step]-G6[step+1],G6[step]-
G7[step+1],G7[step]-G8[step+1],G8[step]-G9[step+1],G9[step]-
MC1[step+1],MC1[step]-MC2[step+1],MC2[step]-MC3[step+1],MC3[step]-
MC4[step+1],MC4[step]-MC5[step+1],MC5[step]-MC6[step+1],MC6[step]-
MC7[step+1],MC7[step]-Rest1[step+1],Rest1[step]-
Rest2[step+1],Rest2[step]-Rest3[step+1],Rest3[step]-
Rest4[step+1],Rest4[step]-Rest5[step+1],Rest5[step]-
Rest6[step+1],Rest6[step]-G1[step+1])
if(G1[step]<size_cowherd){
G1[step+1]<- rbinom(1,Rest6[step], concep)
NPreg[step+1]<-Rest6[step]-G1[step+1]
}
}
out <-cbind(G1,G2,G3,G4,G5,G6,G7,G8,G9,MC1,MC2,MC3,MC4,MC5,MC6,MC7,Rest1,R
est2,Rest3,Rest4,Rest5,Rest6,DeadCows,NPreg)
return(out)
}
下面是输出应该是什么样子的示例。在第23个月，循环再次重新开始。
G1 G2 G3 G4 G5 G6 G7 G8 G9 MC1 MC2 MC3 MC4 MC5 MC6 MC7 Rest1 Rest2 Rest3
Rest4 Rest5 Rest6 DeadCows NPreg
1 96 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 4
2 0 96 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0
3 0 0 96 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0
4 0 0 0 96 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0
5 0 0 0 0 96 0 0 0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0
6 0 0 0 0 0 96 0 0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0
7 0 0 0 0 0 0 96 0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0
8 0 0 0 0 0 0 0 96 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0
9 0 0 0 0 0 0 0 0 96 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0
10 0 0 0 0 0 0 0 0 0 96 0 0 0 0 0 0 0 0 0
0 0 0 0 0
11 0 0 0 0 0 0 0 0 0 0 96 0 0 0 0 0 0 0 0
0 0 0 0 0
12 0 0 0 0 0 0 0 0 0 0 0 96 0 0 0 0 0 0 0
0 0 0 0 0
13 0 0 0 0 0 0 0 0 0 0 0 0 96 0 0 0 0 0 0
0 0 0 0 0
14 0 0 0 0 0 0 0 0 0 0 0 0 0 96 0 0 0 0 0
0 0 0 0 0
15 0 0 0 0 0 0 0 0 0 0 0 0 0 0 96 0 0 0 0
0 0 0 0 0
16 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 96 0 0 0
0 0 0 0 0
17 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 96 0 0
0 0 0 0 0
18 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 96 0
0 0 0 0 0
19 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 95
0 0 0 1 0
20 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
95 0 0 0 0
21 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
0 95 0 0 0
22 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
0 0 94 1 0
答案 0 :(得分：0)
这样的事情对你有用。我认为这里的诀窍是利用矩阵来保持簿记更直接。
size_cowherd <- 100
concep <- 0.95
stage_names <- c(paste0("G",seq(9)), paste0("MC",seq(7)), paste0("Rest",seq(6)))
cows <- function(size_cowherd, concep, t=220, mort=0.0005, names=stage_names) {
n_stages <- length(names)
stages <- matrix(0, t, n_stages)
dead_cows <- n_preg <- rep(NA, t)
stages[1,1] <- rbinom(1, size_cowherd, concep)
dead_cows[1] <- 0
n_preg[1] <- size_cowherd - stages[1,1]
for(tt in 2:t) {
stages[tt,1] <- rbinom(1, stages[tt-1,n_stages], 1-mort)
for(i in 2:n_stages) {
stages[tt,i] <- rbinom(1, stages[tt-1,i-1], 1-mort)
}
dead_cows[tt] <- sum(stages[tt-1,] - stages[tt,c(2:n_stages,1)])
if(stages[tt-1,1] < size_cowherd) {
stages[tt, 1] <- rbinom(1, stages[tt-1,n_stages], concep)
n_preg[tt] <- stages[tt-1,n_stages] - stages[tt,1]
}
}
res <- cbind(stages, dead_cows, n_preg)
colnames(res) <- c(names, "Dead", "N_Preg")
return(res)
}
head(cows(100, 0.95), 24)
G1 G2 G3 G4 G5 G6 G7 G8 G9 MC1 MC2 MC3 MC4 MC5 MC6 MC7 Rest1 Rest2 Rest3 Rest4 Rest5 Rest6 Dead N_Preg
[1,] 96 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 4
[2,] 0 96 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
[3,] 0 0 96 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
[4,] 0 0 0 96 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
[5,] 0 0 0 0 96 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
[6,] 0 0 0 0 0 96 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
[7,] 0 0 0 0 0 0 95 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0
[8,] 0 0 0 0 0 0 0 95 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
[9,] 0 0 0 0 0 0 0 0 95 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
[10,] 0 0 0 0 0 0 0 0 0 95 0 0 0 0 0 0 0 0 0 0 0 0 0 0
[11,] 0 0 0 0 0 0 0 0 0 0 95 0 0 0 0 0 0 0 0 0 0 0 0 0
[12,] 0 0 0 0 0 0 0 0 0 0 0 95 0 0 0 0 0 0 0 0 0 0 0 0
[13,] 0 0 0 0 0 0 0 0 0 0 0 0 95 0 0 0 0 0 0 0 0 0 0 0
[14,] 0 0 0 0 0 0 0 0 0 0 0 0 0 95 0 0 0 0 0 0 0 0 0 0
[15,] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 95 0 0 0 0 0 0 0 0 0
[16,] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 95 0 0 0 0 0 0 0 0
[17,] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 94 0 0 0 0 0 1 0
[18,] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 94 0 0 0 0 0 0
[19,] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 94 0 0 0 0 0
[20,] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 94 0 0 0 0
[21,] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 94 0 0 0
[22,] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 94 0 0
[23,] 92 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 2
[24,] 0 92 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0