簡化/壓縮R中的長時間序列函數
[英]Simplifying/condensing long time series functions in R
問題描述
我有一個很長的時間序列循環，我想簡化/壓縮。 我正在嘗試使用隨機二項分布來模擬十年（每月間隔）期間牛群的產犢。 該功能從牛被牛覆蓋的假設開始。 每個變量都受前一個變量的影響。 變量如下：
每月G1：G9妊娠。 MC1：MC7的母親與小牛一起待了7個月，然后在小牛斷奶之后。 Rest1：Rest6休息時間，然后再次被多頭覆蓋。 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
1 個解決方案
解決方案1
0 已采納 2017-09-28 23:09:35
這樣的事情應該為您工作。 我認為這里的訣竅是利用矩陣來使簿記更加直接。
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
使用R中的函數求2天之間的天並將其壓縮
[英]Finding the days between 2 days using functions in R and condensing the vector
分割時間序列並將不同的函數應用於R中的不同列
[英]Spliiting a time series and applying different functions to different columns in R
聲明:本站的技術帖子網頁，遵循CC BY-SA 4.0協議，如果您需要轉載，請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.