循环的多次迭代 - 种群模型

时间:2016-03-28 15:58:15

标签: r

我有一个5岁的结构化人口模型。我试图重复模型100次(以获得变化)。我努力做到这一点的最好方法可能是因为我不确定如何重复100次1年到5年的结果。换句话说,模拟不应该在第1年100次,然后在第2年100次,因为第1年的人口会持续到第2年。

# INITIALIZE VARIABLES
sum_mat <- matrix(rep(0,3*3),nrow=3)  # Template for summer matrix
cc <- c(0.46,0.33,0.16,0.36,0.42)     # Observed calf:cow ratios

nyears <- 5 # 5 year population model

sims <- 100 # simulate the 5 year population model 100 times

#for (k in 1:sims){

# LOOP THROUGH YEARS
for (i in 1:nyears){

# CONDITION INPUT VARIABLES BY FIRST VS ALL OTHER YEARS
if (i == 1) {
onf  <- 0                 # Initial number of calves (hypothetical population)
ony  <- 250                   # Initial number of yearlings
ona2 <- 500                   # Initial number of cows

} else {
onf  <- 0                     # No calves in new pre-summer year 
ony  <- pops[1]               # Calves during post-summer are now yearlings
ona2 <- pops[2]+pops[3]       # Yearlings during post-summer now adults,added to existing summer adults
}

# SUMMER
pop0 <- c(onf,onf,onf,
        ony,ony,ony,
        ona2,ona2,ona2)       # Vector of age structure at the beginning of summer

  cc2=0

for (j in seq_along(cc)){   # Sample from observed calfcow ratios in order  of list   
  cc2[j]=cc[i]
  }

cowsurv=rnorm(n=1,mean=0.1,sd=.05)  # Randomly select mortality rate for females

sy_s  <- (1-(cowsurv))              # Yearlings summer survival
sa2_s <- (1-(cowsurv))              # Adult summer survival

# Leslie matrix for summer
sum_mat[1,] <- c(0,sy_s*cc2[j],sa2_s*cc2[j])  # Fecundity
sum_mat[2,] <- c(0,sy_s,0) 
sum_mat[3,] <- c(0,0,sa2_s)

demo_s <- pop0*sum_mat                  # Matrix transition process

pop1 <- c(sum(demo_s[1,]),sum(demo_s[1,]),sum(demo_s[1,]),
        sum(demo_s[2,]),sum(demo_s[2,]),sum(demo_s[2,]),
        sum(demo_s[3,]),sum(demo_s[3,]),sum(demo_s[3,]))

pop0  <- c(pop0[1],pop0[4],pop0[7])     # Extract N calves, yearlings,  adults   pre-summer
pops  <- c(pop1[1],pop1[4],pop1[7])     # Extract N calves, yearlings, adults  post-summer
ccmod <- rep(cc2,3)                     # Extract calfcow ratio
age   <- c('calf','1','2')              # Add age-class identifier
stats <- cbind(age,pop0,pops,ccmod)     # Combine the extracted values
stats <- as.data.frame(stats)     

stats$year <- i                         # Add simulation year

# CONDITION OUTPUT BY FIRST VS ALL OTHER YEARS
if (i == 1) {
 write.csv(stats,"popmodel.csv",row.names=FALSE)
} else {
  write.table(stats, file="popmodel.csv", append=T,   row.names=F,col.names=F,sep=",")
}
}

1 个答案:

答案 0 :(得分:1)

您只需将模拟代码放在函数中并使用replicate。例如,以下内容相当于您的代码,但使用矩阵运算更简洁,对我来说,更容易理解:

set.seed(1)     

#Transition matrices

ageing_T <- as.matrix(read.table(text="
            calves yearlings adults
  calves         0         0      0
  yearlings      1         0      0
  adults         0         1      1 
"))

reproduction_T <- as.matrix(read.table(text="
            calves yearlings adults
  calves         0         1      1
  yearlings      0         0      0
  adults         0         0      0
"))

step <- function(state, fecundity, mortality) {
  ((fecundity * reproduction_T) + diag(3)) %*% ((1-mortality) * ageing_T) %*% state
}

sim <- function(init, nyears) {
  qx <- rnorm(nyears,mean=0.1,sd=.05)       
  cc <- c(0.46,0.33,0.16,0.36,0.42)   
  Reduce(function(s,i) step(s, cc[i], qx[i]), 1:nyears, init=init, acc=TRUE)
}

这会产生一次模拟运行:

sim(c(calves=250, yearlings=250, adults=250), 5)

这产生了100个

s <- replicate(100, sim(c(calves=250, yearlings=250, adults=250), 5), simplify=FALSE)

第5年结束时第100次模拟的输出(计数从1开始,到6结束),例如存储在s[[100]][[6]]