data(lathyrus)
sizevector <- c(0, 4.6, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 1, 2, 3, 4, 5, 6, 7, 8,
9)
stagevector <- c("Sd", "Sdl", "Dorm", "Sz1nr", "Sz2nr", "Sz3nr", "Sz4nr",
"Sz5nr", "Sz6nr", "Sz7nr", "Sz8nr", "Sz9nr", "Sz1r", "Sz2r", "Sz3r",
"Sz4r", "Sz5r", "Sz6r", "Sz7r", "Sz8r", "Sz9r")
repvector <- c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1)
obsvector <- c(0, 1, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
matvector <- c(0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
immvector <- c(1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)
propvector <- c(1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0)
indataset <- c(0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
minima <- c(1, 1, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2)
binvec <- c(0, 4.6, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5,
0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5)
lathframeln <- sf_create(sizes = sizevector, stagenames = stagevector,
repstatus = repvector, obsstatus = obsvector, matstatus = matvector,
immstatus = immvector, indataset = indataset, binhalfwidth = binvec,
propstatus = propvector, minage = minima)
lathvertln <- verticalize3(lathyrus, noyears = 4, firstyear = 1988,
patchidcol = "SUBPLOT", individcol = "GENET", blocksize = 9,
juvcol = "Seedling1988", sizeacol = "lnVol88", repstracol = "Intactseed88",
fecacol = "Intactseed88", deadacol = "Dead1988",
nonobsacol = "Dormant1988", stageassign = lathframeln,
stagesize = "sizea", censorcol = "Missing1988", censorkeep = NA,
NAas0 = TRUE, censor = TRUE)
lathvertln$feca2 <- round(lathvertln$feca2)
lathvertln$feca1 <- round(lathvertln$feca1)
lathvertln$feca3 <- round(lathvertln$feca3)
lathvertln_adults <- subset(lathvertln, stage2index > 2)
surv_model <- glm(alive3 ~ obsage + sizea2 + as.factor(patchid) +
as.factor(year2), data = lathvertln_adults, family = "binomial")
obs_data <- subset(lathvertln_adults, alive3 == 1)
obs_model <- glm(obsstatus3 ~ obsage + as.factor(patchid) +
as.factor(year2), data = obs_data, family = "binomial")
size_data <- subset(obs_data, obsstatus3 == 1)
siz_model <- lm(sizea3 ~ sizea2 + repstatus2 + obsage + as.factor(patchid) +
as.factor(year2), data = size_data)
reps_model <- glm(repstatus3 ~ sizea2 + as.factor(patchid) + as.factor(year2),
data = size_data, family = "binomial")
fec_data <- subset(lathvertln_adults, repstatus2 == 1)
fec_model <- glm(feca2 ~ sizea2 + obsage + as.factor(patchid) +
as.factor(year2), data = fec_data, family = "poisson")
lathvertln_juvs <- subset(lathvertln, stage2index < 3)
jsurv_model <- glm(alive3 ~ as.factor(patchid), data = lathvertln_juvs,
family = "binomial")
jobs_data <- subset(lathvertln_juvs, alive3 == 1)
jobs_model <- glm(obsstatus3 ~ 1, family = "binomial", data = jobs_data)
jsize_data <- subset(jobs_data, obsstatus3 == 1)
jsiz_model <- lm(sizea3 ~ as.factor(year2), data = jsize_data)
jrepst_model <- 0
jmatst_model <- 1
lathsupp2 <- supplemental(stage3 = c("Sd", "Sdl", "mat", "Sd", "Sdl"),
stage2 = c("Sd", "Sd", "Sdl", "rep", "rep"),
eststage3 = c(NA, NA, "mat", NA, NA),
eststage2 = c(NA, NA, "Dorm", NA, NA),
givenrate = c(0.345, 0.054, NA, NA, NA),
multiplier = c(NA, NA, 0.8, 0.345, 0.054), type = c(1, 1, 1, 3, 3),
stageframe = lathframeln, historical = FALSE, agebased = TRUE)
mod_params <- create_pm(name_terms = TRUE)
mod_params$modelparams[3] <- "patchid"
mod_params$modelparams[5] <- "obsstatus3"
mod_params$modelparams[6] <- "sizea3"
mod_params$modelparams[9] <- "repstatus3"
mod_params$modelparams[11] <- "feca2"
mod_params$modelparams[12] <- "sizea2"
mod_params$modelparams[18] <- "repstatus2"
mod_params$modelparams[22] <- "obsage"
lathmat2age2 <- aflefko2(year = "all", patch = "all", data = lathvertln,
stageframe = lathframeln, supplement = lathsupp2, final_age = 3,
surv_model = surv_model, obs_model = obs_model, size_model = siz_model,
repst_model = reps_model, fec_model = fec_model, jsurv_model = jsurv_model,
jobs_model = jobs_model, jsize_model = jsiz_model,
jrepst_model = jrepst_model, jmatst_model = jmatst_model,
paramnames = mod_params, continue = TRUE, reduce = FALSE)
Run the code above in your browser using DataLab