inst/examples/create-life_cycle-ATS-smolt-M3.R
In sakrejda/dodo: Code to run IPM in R, with some C++ backend calculations.
library(dodo)
data('estimates-ATS-smolt-M3')
data('stages.ats')
#data('environment-ATS-smolt')
#data('life_cycle-ATS-smolt'); rm(pop, stages, transformations)
## Data:
stages <- structure(
list(
standardize_size = function(df) {
df[['std_sizes']] <- (df[['sizes']] - df[['sizeAtAge']])/df[['sdAtAge']]
return(df)
},
flow_conversion = function(df) {
flowMeans <- c(28,11,12,26)
flowSds <- c(9,5,6,7.5)
df[['flow_std']] <-
(df[['flow']] - flowMeans[df[['season']]]) / flowSds[df[['season']]]
return(df)
},
temp_conversion = function(df) {
tempMeans <- c(18.02234,18.50568,18.06938,17.96012)
tempSds <- c(0.019765602, 0.031461813, 0.022657542, 0.00111111)
df[['temp_std']] <-
(df[['WB']] - tempMeans[df[['season']]]) / tempSds[df[['season']]]
return(df)
}
),
.Names = c("standardize_size", "flow_conversion", "temp_conversion")
)
transformations <- structure(
list(order = 1:6, model = c("clear_smolts", "smolt", "die", "grow", "age", "stock")),
.Names = c("order", "model"),
row.names = c(1L, 2L, 3L, 4L, 5L, 6L), class = "data.frame")
## Aging:
pa <- new('pGLM',
formula = ~ 1,
family = gaussian(link="identity"),
coefficients = list(
"(Intercept)" = 1
),
epsilon = function(n=1) {return(rep(0,n))},
samp = FALSE
)
## Stocking:
sp <- new('pGLM',
formula = ~ 1 + season,
family = binomial(link=rlogit),
coefficients = list(
"(Intercept)" = -100,
season2 = -100,
season3 = -100,
season4 = 100+1.3
),
epsilon = function(n=1) { rnorm(n=n, mean=0, sd=0.1) },
samp = FALSE
)
sf <- new('pGLM',
formula = ~ 1 + season,
family = poisson(link=log),
coefficients = list(
"(Intercept)"=-100,
season2 = -100,
season3 = -100,
season4 = 100+2
),
epsilon = function(n=1) { rnorm(n=n, mean=0, sd=0.01) },
samp = FALSE
)
ss <- new('pGLM',
formula = ~ 1,
family = gaussian(),
coefficients = list("(Intercept)" = 5),
epsilon = function(n=1) { rnorm(n=n, mean=0, sd=0.5) },
samp = FALSE
)
## Fry growth:
fg <- new('pGLM',
formula = ~ 1,
family = gaussian(),
coefficients = list(
"(Intercept)" = 55
),
epsilon = function(n=1) { rnorm(n=n, mean=0, sd=1) },
samp = FALSE
)
## Fry survival:
fm <- new('pGLM',
formula = ~ 1,
family = binomial(link=rlogit),
coefficients = list(
"(Intercept)" = -0.9
),
epsilon = function(n=1) { rnorm(n=n, mean=0, sd=0.2) },
samp = FALSE
)
## Growth of juveniles:
jg <- new('pGLM',
formula = ~ 1 + ageInSamples + offset(sizes),
family = gaussian(link="log"),
coefficients = list(
"(Intercept)" = s[['gr_beta_0']] + s[['gr_beta_ais']][ 1],
ageInSamples2 = s[['gr_beta_0']] + s[['gr_beta_ais']][ 2],
ageInSamples3 = s[['gr_beta_0']] + s[['gr_beta_ais']][ 3],
ageInSamples4 = s[['gr_beta_0']] + s[['gr_beta_ais']][ 4],
ageInSamples5 = s[['gr_beta_0']],
ageInSamples6 = s[['gr_beta_0']] + s[['gr_beta_ais']][ 6],
ageInSamples7 = s[['gr_beta_0']] + s[['gr_beta_ais']][ 7],
ageInSamples8 = s[['gr_beta_0']] + s[['gr_beta_ais']][ 8],
ageInSamples9 = s[['gr_beta_0']] + s[['gr_beta_ais']][ 9],
ageInSamples10 = s[['gr_beta_0']] + s[['gr_beta_ais']][10],
ageInSamples11 = s[['gr_beta_0']] + s[['gr_beta_ais']][11],
ageInSamples12 = s[['gr_beta_0']] + s[['gr_beta_ais']][12],
ageInSamples13 = s[['gr_beta_0']] + s[['gr_beta_ais']][13],
ageInSamples14 = s[['gr_beta_0']] + s[['gr_beta_ais']][14],
ageInSamples15 = rep(0, length(s[['gr_beta_0']]))
),
epsilon = function(n=1) { rnorm(n=n, mean=0, sd=0.5) },
samp = FALSE
)
## Mortality of juveniles:
jm <- new('pGLM',
formula = ~ 1 + ageInSamples + ageInSamples:temp_std + ageInSamples:flow_std +
ageInSamples:std_sizes,
family = binomial(link=rlogit),
coefficients = list(
"(Intercept)" = s[['phi_beta_0']] + s[['phi_beta_ais']][ 1],
ageInSamples2 = s[['phi_beta_0']] + s[['phi_beta_ais']][ 2],
ageInSamples3 = s[['phi_beta_0']] + s[['phi_beta_ais']][ 3],
ageInSamples4 = s[['phi_beta_0']] + s[['phi_beta_ais']][ 4],
ageInSamples5 = s[['phi_beta_0']],
ageInSamples6 = s[['phi_beta_0']] + s[['phi_beta_ais']][ 6],
ageInSamples7 = s[['phi_beta_0']] + s[['phi_beta_ais']][ 7],
ageInSamples8 = s[['phi_beta_0']] + s[['phi_beta_ais']][ 8],
ageInSamples9 = s[['phi_beta_0']] + s[['phi_beta_ais']][ 9],
ageInSamples10 = s[['phi_beta_0']] + s[['phi_beta_ais']][10],
ageInSamples11 = s[['phi_beta_0']] + s[['phi_beta_ais']][11],
ageInSamples12 = s[['phi_beta_0']] + s[['phi_beta_ais']][12],
ageInSamples13 = s[['phi_beta_0']] + s[['phi_beta_ais']][13],
ageInSamples14 = s[['phi_beta_0']] + s[['phi_beta_ais']][14],
ageInSamples15 = rep(-100,length(s[['phi_beta_0']])),
"ageInSamples1:temp_std" = s[['phi_beta_t']] + s[['phi_beta_t_ais']][1],
"ageInSamples2:temp_std" = s[['phi_beta_t']] + s[['phi_beta_t_ais']][2],
"ageInSamples3:temp_std" = s[['phi_beta_t']] + s[['phi_beta_t_ais']][3],
"ageInSamples4:temp_std" = s[['phi_beta_t']] + s[['phi_beta_t_ais']][4],
"ageInSamples5:temp_std" = s[['phi_beta_t']],
"ageInSamples6:temp_std" = s[['phi_beta_t']] + s[['phi_beta_t_ais']][6],
"ageInSamples7:temp_std" = s[['phi_beta_t']] + s[['phi_beta_t_ais']][7],
"ageInSamples8:temp_std" = s[['phi_beta_t']] + s[['phi_beta_t_ais']][8],
"ageInSamples9:temp_std" = s[['phi_beta_t']] + s[['phi_beta_t_ais']][9],
"ageInSamples10:temp_std" = s[['phi_beta_t']] + s[['phi_beta_t_ais']][10],
"ageInSamples11:temp_std" = s[['phi_beta_t']] + s[['phi_beta_t_ais']][11],
"ageInSamples12:temp_std" = s[['phi_beta_t']] + s[['phi_beta_t_ais']][12],
"ageInSamples13:temp_std" = s[['phi_beta_t']] + s[['phi_beta_t_ais']][13],
"ageInSamples14:temp_std" = s[['phi_beta_t']] + s[['phi_beta_t_ais']][14],
"ageInSamples15:temp_std" = rep(0, length(s[['gr_beta_0']])),
"ageInSamples1:flow_std" = s[['phi_beta_d']] + s[['phi_beta_d_ais']][1],
"ageInSamples2:flow_std" = s[['phi_beta_d']] + s[['phi_beta_d_ais']][2],
"ageInSamples3:flow_std" = s[['phi_beta_d']] + s[['phi_beta_d_ais']][3],
"ageInSamples4:flow_std" = s[['phi_beta_d']] + s[['phi_beta_d_ais']][4],
"ageInSamples5:flow_std" = s[['phi_beta_d']],
"ageInSamples6:flow_std" = s[['phi_beta_d']] + s[['phi_beta_d_ais']][6],
"ageInSamples7:flow_std" = s[['phi_beta_d']] + s[['phi_beta_d_ais']][7],
"ageInSamples8:flow_std" = s[['phi_beta_d']] + s[['phi_beta_d_ais']][8],
"ageInSamples9:flow_std" = s[['phi_beta_d']] + s[['phi_beta_d_ais']][9],
"ageInSamples10:flow_std" = s[['phi_beta_d']] + s[['phi_beta_d_ais']][10],
"ageInSamples11:flow_std" = s[['phi_beta_d']] + s[['phi_beta_d_ais']][11],
"ageInSamples12:flow_std" = s[['phi_beta_d']] + s[['phi_beta_d_ais']][12],
"ageInSamples13:flow_std" = s[['phi_beta_d']] + s[['phi_beta_d_ais']][13],
"ageInSamples14:flow_std" = s[['phi_beta_d']] + s[['phi_beta_d_ais']][14],
"ageInSamples15:flow_std" = rep(0, length(s[['gr_beta_0']])),
"ageInSamples1:std_sizes" = s[['phi_beta_size']] + s[['phi_beta_size_ais']][1],
"ageInSamples2:std_sizes" = s[['phi_beta_size']] + s[['phi_beta_size_ais']][2],
"ageInSamples3:std_sizes" = s[['phi_beta_size']] + s[['phi_beta_size_ais']][3],
"ageInSamples4:std_sizes" = s[['phi_beta_size']] + s[['phi_beta_size_ais']][4],
"ageInSamples5:std_sizes" = s[['phi_beta_size']],
"ageInSamples6:std_sizes" = s[['phi_beta_size']] + s[['phi_beta_size_ais']][6],
"ageInSamples7:std_sizes" = s[['phi_beta_size']] + s[['phi_beta_size_ais']][7],
"ageInSamples8:std_sizes" = s[['phi_beta_size']] + s[['phi_beta_size_ais']][8],
"ageInSamples9:std_sizes" = s[['phi_beta_size']] + s[['phi_beta_size_ais']][9],
"ageInSamples10:std_sizes" = s[['phi_beta_size']] + s[['phi_beta_size_ais']][10],
"ageInSamples11:std_sizes" = s[['phi_beta_size']] + s[['phi_beta_size_ais']][11],
"ageInSamples12:std_sizes" = s[['phi_beta_size']] + s[['phi_beta_size_ais']][12],
"ageInSamples13:std_sizes" = s[['phi_beta_size']] + s[['phi_beta_size_ais']][13],
"ageInSamples14:std_sizes" = s[['phi_beta_size']] + s[['phi_beta_size_ais']][14],
"ageInSamples15:std_sizes" = rep(0, length(s[['gr_beta_0']]))
),
epsilon = function(n=1) { rnorm(n=n, mean=0, sd=0.1) },
samp = FALSE
)
## Smolting of juveniles:
js1 <- new('pGLM',
formula = ~ 1,
family = binomial(link=logit),
coefficients = list(
"(Intercept)" = -2.5
),
epsilon = function(n=1) { rnorm(n=n, mean=0, sd=0.1) },
samp = FALSE
)
js2 <- new('pGLM',
formula = ~ 1,
family = binomial(link=logit),
coefficients = list(
"(Intercept)" = 0.5
),
epsilon = function(n=1) { rnorm(n=n, mean=0, sd=0.1) },
samp = FALSE
)
js3 <- new('pGLM',
formula = ~ 1,
family = binomial(link=logit),
coefficients = list(
"(Intercept)" = 1.5
),
epsilon = function(n=1) { rnorm(n=n, mean=0, sd=0.1) },
samp = FALSE
)
js4 <- new('pGLM',
formula = ~ 1,
family = binomial(link=logit),
coefficients = list(
"(Intercept)" = 1.0
),
epsilon = function(n=1) { rnorm(n=n, mean=0, sd=0.1) },
samp = FALSE
)
## Make a blank population, this has to happen once:
pop <- population$new(
stages = stages, transformations = transformations)
## Build/Add the models:
## Stock:
pop$add_model(
stage = 'stock',
transformation = 'stock',
model = staged_reproduction_factory('stock','fry', sp, sf, ss))
## Fry:
pop$add_model(
stage = 'fry',
transformation = 'grow',
model = staged_growth_factory('fry', fg))
pop$add_model(
stage = 'fry',
transformation = 'die',
model = staged_transition_factory('fry', 'dead_fry', fm))
pop$add_model(
stage = 'fry',
transformation = 'age',
model = staged_transition_factory('fry','zero_summer_parr', pa))
## Zero plus.
pop$add_model(
stage = 'zero_summer_parr',
transformation = 'grow',
model = staged_growth_factory('zero_summer_parr', jg))
pop$add_model(
stage = 'zero_summer_parr',
transformation = 'die',
model = staged_transition_factory('zero_summer_parr', 'dead_zero_summer_parr', jm))
pop$add_model(
stage = 'zero_summer_parr',
transformation = 'age',
model = staged_transition_factory('zero_summer_parr', 'zero_autumn_parr', pa))
pop$add_model(
stage = 'zero_autumn_parr',
transformation = 'grow',
model = staged_growth_factory('zero_autumn_parr', jg))
pop$add_model(
stage = 'zero_autumn_parr',
transformation = 'die',
model = staged_transition_factory('zero_autumn_parr', 'dead_zero_autumn_parr', jm))
pop$add_model(
stage = 'zero_autumn_parr',
transformation = 'age',
model = staged_transition_factory('zero_autumn_parr', 'zero_winter_parr', pa))
pop$add_model(
stage = 'zero_winter_parr',
transformation = 'grow',
model = staged_growth_factory('zero_winter_parr', jg))
pop$add_model(
stage = 'zero_winter_parr',
transformation = 'die',
model = staged_transition_factory('zero_winter_parr', 'dead_zero_winter_parr', jm))
pop$add_model(
stage = 'zero_winter_parr',
transformation = 'age',
model = staged_transition_factory('zero_winter_parr', 'one_spring_parr', pa))
## One plus:
pop$add_model(
stage = 'one_spring_parr',
transformation = 'grow',
model = staged_growth_factory('one_spring_parr', jg))
pop$add_model(
stage = 'one_spring_parr',
transformation = 'die',
model = staged_transition_factory('one_spring_parr', 'dead_one_summer_parr', jm))
pop$add_model(
stage = 'one_spring_parr',
transformation = 'age',
model = staged_transition_factory('one_spring_parr', 'one_summer_parr', pa))
pop$add_model(
stage = 'one_summer_parr',
transformation = 'grow',
model = staged_growth_factory('one_summer_parr', jg))
pop$add_model(
stage = 'one_summer_parr',
transformation = 'die',
model = staged_transition_factory('one_summer_parr', 'dead_one_summer_parr', jm))
pop$add_model(
stage = 'one_summer_parr',
transformation = 'age',
model = staged_transition_factory('one_summer_parr', 'one_autumn_parr', pa))
pop$add_model(
stage = 'one_autumn_parr',
transformation = 'grow',
model = staged_growth_factory('one_autumn_parr', jg))
pop$add_model(
stage = 'one_autumn_parr',
transformation = 'die',
model = staged_transition_factory('one_autumn_parr', 'dead_one_autumn_parr', jm))
pop$add_model(
stage = 'one_autumn_parr',
transformation = 'age',
model = staged_transition_factory('one_autumn_parr', 'one_winter_parr', pa))
pop$add_model(
stage = 'one_winter_parr',
transformation = 'grow',
model = staged_growth_factory('one_winter_parr', jg))
pop$add_model(
stage = 'one_winter_parr',
transformation = 'die',
model = staged_transition_factory('one_winter_parr', 'dead_one_winter_parr', jm))
pop$add_model(
stage = 'one_winter_parr',
transformation = 'age',
model = staged_transition_factory('one_winter_parr', 'two_spring_parr', pa))
## Two plus:
pop$add_model(
stage = 'two_spring_parr',
transformation = 'grow',
model = staged_growth_factory('two_spring_parr', jg))
pop$add_model(
stage = 'two_spring_parr',
transformation = 'die',
model = staged_transition_factory('two_spring_parr', 'dead_two_spring_parr', jm))
pop$add_model(
stage = 'two_spring_parr',
transformation = 'age',
model = staged_transition_factory('two_spring_parr', 'two_summer_parr', pa))
pop$add_model(
stage = 'two_summer_parr',
transformation = 'grow',
model = staged_growth_factory('two_summer_parr', jg))
pop$add_model(
stage = 'two_summer_parr',
transformation = 'die',
model = staged_transition_factory('two_summer_parr', 'dead_two_summer_parr', jm))
pop$add_model(
stage = 'two_summer_parr',
transformation = 'age',
model = staged_transition_factory('two_summer_parr', 'two_autumn_parr', pa))
pop$add_model(
stage = 'two_autumn_parr',
transformation = 'grow',
model = staged_growth_factory('two_autumn_parr', jg))
pop$add_model(
stage = 'two_autumn_parr',
transformation = 'die',
model = staged_transition_factory('two_autumn_parr', 'dead_two_autumn_parr', jm))
pop$add_model(
stage = 'two_autumn_parr',
transformation = 'age',
model = staged_transition_factory('two_autumn_parr', 'two_winter_parr', pa))
pop$add_model(
stage = 'two_winter_parr',
transformation = 'grow',
model = staged_growth_factory('two_winter_parr', jg))
pop$add_model(
stage = 'two_winter_parr',
transformation = 'die',
model = staged_transition_factory('two_winter_parr', 'dead_two_winter_parr', jm))
pop$add_model(
stage = 'two_winter_parr',
transformation = 'age',
model = staged_transition_factory('two_winter_parr', 'three_spring_parr', pa))
## Three plus:
pop$add_model(
stage = 'three_spring_parr',
transformation = 'grow',
model = staged_growth_factory('three_spring_parr', jg))
pop$add_model(
stage = 'three_spring_parr',
transformation = 'die',
model = staged_transition_factory('three_spring_parr', 'dead_three_spring_parr', jm))
pop$add_model(
stage = 'three_spring_parr',
transformation = 'age',
model = staged_transition_factory('three_spring_parr', 'three_summer_parr', pa))
pop$add_model(
stage = 'three_summer_parr',
transformation = 'grow',
model = staged_growth_factory('three_summer_parr', jg))
pop$add_model(
stage = 'three_summer_parr',
transformation = 'die',
model = staged_transition_factory('three_summer_parr', 'dead_three_summer_parr', jm))
pop$add_model(
stage = 'three_summer_parr',
transformation = 'age',
model = staged_transition_factory('three_summer_parr', 'three_autumn_parr', pa))
pop$add_model(
stage = 'three_autumn_parr',
transformation = 'grow',
model = staged_growth_factory('three_autumn_parr', jg))
pop$add_model(
stage = 'three_autumn_parr',
transformation = 'die',
model = staged_transition_factory('three_autumn_parr', 'dead_three_autumn_parr', jm))
pop$add_model(
stage = 'three_autumn_parr',
transformation = 'age',
model = staged_transition_factory('three_autumn_parr', 'three_winter_parr', pa))
pop$add_model(
stage = 'three_winter_parr',
transformation = 'grow',
model = staged_growth_factory('three_winter_parr', jg))
pop$add_model(
stage = 'three_winter_parr',
transformation = 'die',
model = staged_transition_factory('three_winter_parr', 'dead_three_winter_parr', jm))
pop$add_model(
stage = 'three_winter_parr',
transformation = 'age',
model = staged_transition_factory('three_winter_parr', 'four_spring_parr', pa))
## Four plus:
pop$add_model(
stage = 'four_spring_parr',
transformation = 'grow',
model = staged_growth_factory('four_spring_parr', jg))
pop$add_model(
stage = 'four_spring_parr',
transformation = 'die',
model = staged_transition_factory('four_spring_parr', 'dead_four_spring_parr', jm))
pop$add_model(
stage = 'four_spring_parr',
transformation = 'age',
model = staged_transition_factory('four_spring_parr', 'four_summer_parr', pa))
pop$add_model(
stage = 'four_summer_parr',
transformation = 'grow',
model = staged_growth_factory('four_summer_parr', jg))
pop$add_model(
stage = 'four_summer_parr',
transformation = 'die',
model = staged_transition_factory('four_summer_parr', 'dead_four_summer_parr', jm))
pop$add_model(
stage = 'four_summer_parr',
transformation = 'age',
model = staged_transition_factory('four_summer_parr', 'four_autumn_parr', pa))
pop$add_model(
stage = 'four_autumn_parr',
transformation = 'grow',
model = staged_growth_factory('four_autumn_parr', jg))
pop$add_model(
stage = 'four_autumn_parr',
transformation = 'die',
model = staged_transition_factory('four_autumn_parr', 'dead_four_autumn_parr', jm))
pop$add_model(
stage = 'four_autumn_parr',
transformation = 'age',
model = staged_transition_factory('four_autumn_parr', 'four_winter_parr', pa))
pop$add_model(
stage = 'four_winter_parr',
transformation = 'grow',
model = staged_growth_factory('four_winter_parr', jg))
pop$add_model(
stage = 'four_winter_parr',
transformation = 'die',
model = staged_transition_factory('four_winter_parr', 'dead_four_winter_parr', jm))
## Smolting:
pop$add_model(
stage = 'two_spring_parr',
transformation = 'smolt',
model = staged_transition_factory('two_spring_parr', 'two_spring_riverine', js2))
pop$add_model(
stage = 'three_spring_parr',
transformation = 'smolt',
model = staged_transition_factory('three_spring_parr', 'three_spring_riverine', js3))
pop$add_model(
stage = 'four_spring_parr',
transformation = 'smolt',
model = staged_transition_factory('four_spring_parr', 'four_spring_riverine', js4))
pop$add_model(
stage = 'two_spring_riverine',
transformation = 'clear_smolts',
model = staged_transition_factory(
'two_spring_riverine', 'two_spring_riverine_total', pa))
pop$add_model(
stage = 'three_spring_riverine',
transformation = 'clear_smolts',
model = staged_transition_factory(
'three_spring_riverine', 'three_spring_riverine_total', pa))
pop$add_model(
stage = 'four_spring_riverine',
transformation = 'clear_smolts',
model = staged_transition_factory(
'four_spring_riverine', 'four_spring_riverine_total', pa))
################################################################################
################################################################################
## To get everything above this line, one would do:
## data("life_cycle-ATS-smolt")
##
################################################################################
################################################################################
pop$clear()
#save(s2, file='../../data/estimates-ATS-smolt-M1.RData')
#save(envir, file='../../data/environment-ATS-smolt.RData')
save(stages, transformations, envir, pop, file='../../data/life_cycle-ATS-smolt-M2.RData')
library(dodo)
o <- within(data = list(), expr = {
stages = letters
n_bins = rbinom(n=length(letters), size=5, prob=0.3) + 1
minima = rep(0,length(letters))
maxima = rep(100, length(letters))
distr <- new('block_distribution', stages=stages, n_bins=n_bins,
minima=minima, maxima=maxima)
distr_summary <- distr$summary
proje <- new('block_projection', stages=stages, bins=n_bins)
proje_plot <- proje$plot
new_distr <- proje %*% distr
})
sakrejda/dodo documentation built on May 29, 2019, 1 p.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
library(dodo)
data('estimates-ATS-smolt-M3')
data('stages.ats')
#data('environment-ATS-smolt')
#data('life_cycle-ATS-smolt'); rm(pop, stages, transformations)
## Data:
stages <- structure(
list(
standardize_size = function(df) {
df[['std_sizes']] <- (df[['sizes']] - df[['sizeAtAge']])/df[['sdAtAge']]
return(df)
},
flow_conversion = function(df) {
flowMeans <- c(28,11,12,26)
flowSds <- c(9,5,6,7.5)
df[['flow_std']] <-
(df[['flow']] - flowMeans[df[['season']]]) / flowSds[df[['season']]]
return(df)
},
temp_conversion = function(df) {
tempMeans <- c(18.02234,18.50568,18.06938,17.96012)
tempSds <- c(0.019765602, 0.031461813, 0.022657542, 0.00111111)
df[['temp_std']] <-
(df[['WB']] - tempMeans[df[['season']]]) / tempSds[df[['season']]]
return(df)
}
),
.Names = c("standardize_size", "flow_conversion", "temp_conversion")
)
transformations <- structure(
list(order = 1:6, model = c("clear_smolts", "smolt", "die", "grow", "age", "stock")),
.Names = c("order", "model"),
row.names = c(1L, 2L, 3L, 4L, 5L, 6L), class = "data.frame")
## Aging:
pa <- new('pGLM',
formula = ~ 1,
family = gaussian(link="identity"),
coefficients = list(
"(Intercept)" = 1
),
epsilon = function(n=1) {return(rep(0,n))},
samp = FALSE
)
## Stocking:
sp <- new('pGLM',
formula = ~ 1 + season,
family = binomial(link=rlogit),
coefficients = list(
"(Intercept)" = -100,
season2 = -100,
season3 = -100,
season4 = 100+1.3
),
epsilon = function(n=1) { rnorm(n=n, mean=0, sd=0.1) },
samp = FALSE
)
sf <- new('pGLM',
formula = ~ 1 + season,
family = poisson(link=log),
coefficients = list(
"(Intercept)"=-100,
season2 = -100,
season3 = -100,
season4 = 100+2
),
epsilon = function(n=1) { rnorm(n=n, mean=0, sd=0.01) },
samp = FALSE
)
ss <- new('pGLM',
formula = ~ 1,
family = gaussian(),
coefficients = list("(Intercept)" = 5),
epsilon = function(n=1) { rnorm(n=n, mean=0, sd=0.5) },
samp = FALSE
)
## Fry growth:
fg <- new('pGLM',
formula = ~ 1,
family = gaussian(),
coefficients = list(
"(Intercept)" = 55
),
epsilon = function(n=1) { rnorm(n=n, mean=0, sd=1) },
samp = FALSE
)
## Fry survival:
fm <- new('pGLM',
formula = ~ 1,
family = binomial(link=rlogit),
coefficients = list(
"(Intercept)" = -0.9
),
epsilon = function(n=1) { rnorm(n=n, mean=0, sd=0.2) },
samp = FALSE
)
## Growth of juveniles:
jg <- new('pGLM',
formula = ~ 1 + ageInSamples + offset(sizes),
family = gaussian(link="log"),
coefficients = list(
"(Intercept)" = s[['gr_beta_0']] + s[['gr_beta_ais']][ 1],
ageInSamples2 = s[['gr_beta_0']] + s[['gr_beta_ais']][ 2],
ageInSamples3 = s[['gr_beta_0']] + s[['gr_beta_ais']][ 3],
ageInSamples4 = s[['gr_beta_0']] + s[['gr_beta_ais']][ 4],
ageInSamples5 = s[['gr_beta_0']],
ageInSamples6 = s[['gr_beta_0']] + s[['gr_beta_ais']][ 6],
ageInSamples7 = s[['gr_beta_0']] + s[['gr_beta_ais']][ 7],
ageInSamples8 = s[['gr_beta_0']] + s[['gr_beta_ais']][ 8],
ageInSamples9 = s[['gr_beta_0']] + s[['gr_beta_ais']][ 9],
ageInSamples10 = s[['gr_beta_0']] + s[['gr_beta_ais']][10],
ageInSamples11 = s[['gr_beta_0']] + s[['gr_beta_ais']][11],
ageInSamples12 = s[['gr_beta_0']] + s[['gr_beta_ais']][12],
ageInSamples13 = s[['gr_beta_0']] + s[['gr_beta_ais']][13],
ageInSamples14 = s[['gr_beta_0']] + s[['gr_beta_ais']][14],
ageInSamples15 = rep(0, length(s[['gr_beta_0']]))
),
epsilon = function(n=1) { rnorm(n=n, mean=0, sd=0.5) },
samp = FALSE
)
## Mortality of juveniles:
jm <- new('pGLM',
formula = ~ 1 + ageInSamples + ageInSamples:temp_std + ageInSamples:flow_std +
ageInSamples:std_sizes,
family = binomial(link=rlogit),
coefficients = list(
"(Intercept)" = s[['phi_beta_0']] + s[['phi_beta_ais']][ 1],
ageInSamples2 = s[['phi_beta_0']] + s[['phi_beta_ais']][ 2],
ageInSamples3 = s[['phi_beta_0']] + s[['phi_beta_ais']][ 3],
ageInSamples4 = s[['phi_beta_0']] + s[['phi_beta_ais']][ 4],
ageInSamples5 = s[['phi_beta_0']],
ageInSamples6 = s[['phi_beta_0']] + s[['phi_beta_ais']][ 6],
ageInSamples7 = s[['phi_beta_0']] + s[['phi_beta_ais']][ 7],
ageInSamples8 = s[['phi_beta_0']] + s[['phi_beta_ais']][ 8],
ageInSamples9 = s[['phi_beta_0']] + s[['phi_beta_ais']][ 9],
ageInSamples10 = s[['phi_beta_0']] + s[['phi_beta_ais']][10],
ageInSamples11 = s[['phi_beta_0']] + s[['phi_beta_ais']][11],
ageInSamples12 = s[['phi_beta_0']] + s[['phi_beta_ais']][12],
ageInSamples13 = s[['phi_beta_0']] + s[['phi_beta_ais']][13],
ageInSamples14 = s[['phi_beta_0']] + s[['phi_beta_ais']][14],
ageInSamples15 = rep(-100,length(s[['phi_beta_0']])),
"ageInSamples1:temp_std" = s[['phi_beta_t']] + s[['phi_beta_t_ais']][1],
"ageInSamples2:temp_std" = s[['phi_beta_t']] + s[['phi_beta_t_ais']][2],
"ageInSamples3:temp_std" = s[['phi_beta_t']] + s[['phi_beta_t_ais']][3],
"ageInSamples4:temp_std" = s[['phi_beta_t']] + s[['phi_beta_t_ais']][4],
"ageInSamples5:temp_std" = s[['phi_beta_t']],
"ageInSamples6:temp_std" = s[['phi_beta_t']] + s[['phi_beta_t_ais']][6],
"ageInSamples7:temp_std" = s[['phi_beta_t']] + s[['phi_beta_t_ais']][7],
"ageInSamples8:temp_std" = s[['phi_beta_t']] + s[['phi_beta_t_ais']][8],
"ageInSamples9:temp_std" = s[['phi_beta_t']] + s[['phi_beta_t_ais']][9],
"ageInSamples10:temp_std" = s[['phi_beta_t']] + s[['phi_beta_t_ais']][10],
"ageInSamples11:temp_std" = s[['phi_beta_t']] + s[['phi_beta_t_ais']][11],
"ageInSamples12:temp_std" = s[['phi_beta_t']] + s[['phi_beta_t_ais']][12],
"ageInSamples13:temp_std" = s[['phi_beta_t']] + s[['phi_beta_t_ais']][13],
"ageInSamples14:temp_std" = s[['phi_beta_t']] + s[['phi_beta_t_ais']][14],
"ageInSamples15:temp_std" = rep(0, length(s[['gr_beta_0']])),
"ageInSamples1:flow_std" = s[['phi_beta_d']] + s[['phi_beta_d_ais']][1],
"ageInSamples2:flow_std" = s[['phi_beta_d']] + s[['phi_beta_d_ais']][2],
"ageInSamples3:flow_std" = s[['phi_beta_d']] + s[['phi_beta_d_ais']][3],
"ageInSamples4:flow_std" = s[['phi_beta_d']] + s[['phi_beta_d_ais']][4],
"ageInSamples5:flow_std" = s[['phi_beta_d']],
"ageInSamples6:flow_std" = s[['phi_beta_d']] + s[['phi_beta_d_ais']][6],
"ageInSamples7:flow_std" = s[['phi_beta_d']] + s[['phi_beta_d_ais']][7],
"ageInSamples8:flow_std" = s[['phi_beta_d']] + s[['phi_beta_d_ais']][8],
"ageInSamples9:flow_std" = s[['phi_beta_d']] + s[['phi_beta_d_ais']][9],
"ageInSamples10:flow_std" = s[['phi_beta_d']] + s[['phi_beta_d_ais']][10],
"ageInSamples11:flow_std" = s[['phi_beta_d']] + s[['phi_beta_d_ais']][11],
"ageInSamples12:flow_std" = s[['phi_beta_d']] + s[['phi_beta_d_ais']][12],
"ageInSamples13:flow_std" = s[['phi_beta_d']] + s[['phi_beta_d_ais']][13],
"ageInSamples14:flow_std" = s[['phi_beta_d']] + s[['phi_beta_d_ais']][14],
"ageInSamples15:flow_std" = rep(0, length(s[['gr_beta_0']])),
"ageInSamples1:std_sizes" = s[['phi_beta_size']] + s[['phi_beta_size_ais']][1],
"ageInSamples2:std_sizes" = s[['phi_beta_size']] + s[['phi_beta_size_ais']][2],
"ageInSamples3:std_sizes" = s[['phi_beta_size']] + s[['phi_beta_size_ais']][3],
"ageInSamples4:std_sizes" = s[['phi_beta_size']] + s[['phi_beta_size_ais']][4],
"ageInSamples5:std_sizes" = s[['phi_beta_size']],
"ageInSamples6:std_sizes" = s[['phi_beta_size']] + s[['phi_beta_size_ais']][6],
"ageInSamples7:std_sizes" = s[['phi_beta_size']] + s[['phi_beta_size_ais']][7],
"ageInSamples8:std_sizes" = s[['phi_beta_size']] + s[['phi_beta_size_ais']][8],
"ageInSamples9:std_sizes" = s[['phi_beta_size']] + s[['phi_beta_size_ais']][9],
"ageInSamples10:std_sizes" = s[['phi_beta_size']] + s[['phi_beta_size_ais']][10],
"ageInSamples11:std_sizes" = s[['phi_beta_size']] + s[['phi_beta_size_ais']][11],
"ageInSamples12:std_sizes" = s[['phi_beta_size']] + s[['phi_beta_size_ais']][12],
"ageInSamples13:std_sizes" = s[['phi_beta_size']] + s[['phi_beta_size_ais']][13],
"ageInSamples14:std_sizes" = s[['phi_beta_size']] + s[['phi_beta_size_ais']][14],
"ageInSamples15:std_sizes" = rep(0, length(s[['gr_beta_0']]))
),
epsilon = function(n=1) { rnorm(n=n, mean=0, sd=0.1) },
samp = FALSE
)
## Smolting of juveniles:
js1 <- new('pGLM',
formula = ~ 1,
family = binomial(link=logit),
coefficients = list(
"(Intercept)" = -2.5
),
epsilon = function(n=1) { rnorm(n=n, mean=0, sd=0.1) },
samp = FALSE
)
js2 <- new('pGLM',
formula = ~ 1,
family = binomial(link=logit),
coefficients = list(
"(Intercept)" = 0.5
),
epsilon = function(n=1) { rnorm(n=n, mean=0, sd=0.1) },
samp = FALSE
)
js3 <- new('pGLM',
formula = ~ 1,
family = binomial(link=logit),
coefficients = list(
"(Intercept)" = 1.5
),
epsilon = function(n=1) { rnorm(n=n, mean=0, sd=0.1) },
samp = FALSE
)
js4 <- new('pGLM',
formula = ~ 1,
family = binomial(link=logit),
coefficients = list(
"(Intercept)" = 1.0
),
epsilon = function(n=1) { rnorm(n=n, mean=0, sd=0.1) },
samp = FALSE
)
## Make a blank population, this has to happen once:
pop <- population$new(
stages = stages, transformations = transformations)
## Build/Add the models:
## Stock:
pop$add_model(
stage = 'stock',
transformation = 'stock',
model = staged_reproduction_factory('stock','fry', sp, sf, ss))
## Fry:
pop$add_model(
stage = 'fry',
transformation = 'grow',
model = staged_growth_factory('fry', fg))
pop$add_model(
stage = 'fry',
transformation = 'die',
model = staged_transition_factory('fry', 'dead_fry', fm))
pop$add_model(
stage = 'fry',
transformation = 'age',
model = staged_transition_factory('fry','zero_summer_parr', pa))
## Zero plus.
pop$add_model(
stage = 'zero_summer_parr',
transformation = 'grow',
model = staged_growth_factory('zero_summer_parr', jg))
pop$add_model(
stage = 'zero_summer_parr',
transformation = 'die',
model = staged_transition_factory('zero_summer_parr', 'dead_zero_summer_parr', jm))
pop$add_model(
stage = 'zero_summer_parr',
transformation = 'age',
model = staged_transition_factory('zero_summer_parr', 'zero_autumn_parr', pa))
pop$add_model(
stage = 'zero_autumn_parr',
transformation = 'grow',
model = staged_growth_factory('zero_autumn_parr', jg))
pop$add_model(
stage = 'zero_autumn_parr',
transformation = 'die',
model = staged_transition_factory('zero_autumn_parr', 'dead_zero_autumn_parr', jm))
pop$add_model(
stage = 'zero_autumn_parr',
transformation = 'age',
model = staged_transition_factory('zero_autumn_parr', 'zero_winter_parr', pa))
pop$add_model(
stage = 'zero_winter_parr',
transformation = 'grow',
model = staged_growth_factory('zero_winter_parr', jg))
pop$add_model(
stage = 'zero_winter_parr',
transformation = 'die',
model = staged_transition_factory('zero_winter_parr', 'dead_zero_winter_parr', jm))
pop$add_model(
stage = 'zero_winter_parr',
transformation = 'age',
model = staged_transition_factory('zero_winter_parr', 'one_spring_parr', pa))
## One plus:
pop$add_model(
stage = 'one_spring_parr',
transformation = 'grow',
model = staged_growth_factory('one_spring_parr', jg))
pop$add_model(
stage = 'one_spring_parr',
transformation = 'die',
model = staged_transition_factory('one_spring_parr', 'dead_one_summer_parr', jm))
pop$add_model(
stage = 'one_spring_parr',
transformation = 'age',
model = staged_transition_factory('one_spring_parr', 'one_summer_parr', pa))
pop$add_model(
stage = 'one_summer_parr',
transformation = 'grow',
model = staged_growth_factory('one_summer_parr', jg))
pop$add_model(
stage = 'one_summer_parr',
transformation = 'die',
model = staged_transition_factory('one_summer_parr', 'dead_one_summer_parr', jm))
pop$add_model(
stage = 'one_summer_parr',
transformation = 'age',
model = staged_transition_factory('one_summer_parr', 'one_autumn_parr', pa))
pop$add_model(
stage = 'one_autumn_parr',
transformation = 'grow',
model = staged_growth_factory('one_autumn_parr', jg))
pop$add_model(
stage = 'one_autumn_parr',
transformation = 'die',
model = staged_transition_factory('one_autumn_parr', 'dead_one_autumn_parr', jm))
pop$add_model(
stage = 'one_autumn_parr',
transformation = 'age',
model = staged_transition_factory('one_autumn_parr', 'one_winter_parr', pa))
pop$add_model(
stage = 'one_winter_parr',
transformation = 'grow',
model = staged_growth_factory('one_winter_parr', jg))
pop$add_model(
stage = 'one_winter_parr',
transformation = 'die',
model = staged_transition_factory('one_winter_parr', 'dead_one_winter_parr', jm))
pop$add_model(
stage = 'one_winter_parr',
transformation = 'age',
model = staged_transition_factory('one_winter_parr', 'two_spring_parr', pa))
## Two plus:
pop$add_model(
stage = 'two_spring_parr',
transformation = 'grow',
model = staged_growth_factory('two_spring_parr', jg))
pop$add_model(
stage = 'two_spring_parr',
transformation = 'die',
model = staged_transition_factory('two_spring_parr', 'dead_two_spring_parr', jm))
pop$add_model(
stage = 'two_spring_parr',
transformation = 'age',
model = staged_transition_factory('two_spring_parr', 'two_summer_parr', pa))
pop$add_model(
stage = 'two_summer_parr',
transformation = 'grow',
model = staged_growth_factory('two_summer_parr', jg))
pop$add_model(
stage = 'two_summer_parr',
transformation = 'die',
model = staged_transition_factory('two_summer_parr', 'dead_two_summer_parr', jm))
pop$add_model(
stage = 'two_summer_parr',
transformation = 'age',
model = staged_transition_factory('two_summer_parr', 'two_autumn_parr', pa))
pop$add_model(
stage = 'two_autumn_parr',
transformation = 'grow',
model = staged_growth_factory('two_autumn_parr', jg))
pop$add_model(
stage = 'two_autumn_parr',
transformation = 'die',
model = staged_transition_factory('two_autumn_parr', 'dead_two_autumn_parr', jm))
pop$add_model(
stage = 'two_autumn_parr',
transformation = 'age',
model = staged_transition_factory('two_autumn_parr', 'two_winter_parr', pa))
pop$add_model(
stage = 'two_winter_parr',
transformation = 'grow',
model = staged_growth_factory('two_winter_parr', jg))
pop$add_model(
stage = 'two_winter_parr',
transformation = 'die',
model = staged_transition_factory('two_winter_parr', 'dead_two_winter_parr', jm))
pop$add_model(
stage = 'two_winter_parr',
transformation = 'age',
model = staged_transition_factory('two_winter_parr', 'three_spring_parr', pa))
## Three plus:
pop$add_model(
stage = 'three_spring_parr',
transformation = 'grow',
model = staged_growth_factory('three_spring_parr', jg))
pop$add_model(
stage = 'three_spring_parr',
transformation = 'die',
model = staged_transition_factory('three_spring_parr', 'dead_three_spring_parr', jm))
pop$add_model(
stage = 'three_spring_parr',
transformation = 'age',
model = staged_transition_factory('three_spring_parr', 'three_summer_parr', pa))
pop$add_model(
stage = 'three_summer_parr',
transformation = 'grow',
model = staged_growth_factory('three_summer_parr', jg))
pop$add_model(
stage = 'three_summer_parr',
transformation = 'die',
model = staged_transition_factory('three_summer_parr', 'dead_three_summer_parr', jm))
pop$add_model(
stage = 'three_summer_parr',
transformation = 'age',
model = staged_transition_factory('three_summer_parr', 'three_autumn_parr', pa))
pop$add_model(
stage = 'three_autumn_parr',
transformation = 'grow',
model = staged_growth_factory('three_autumn_parr', jg))
pop$add_model(
stage = 'three_autumn_parr',
transformation = 'die',
model = staged_transition_factory('three_autumn_parr', 'dead_three_autumn_parr', jm))
pop$add_model(
stage = 'three_autumn_parr',
transformation = 'age',
model = staged_transition_factory('three_autumn_parr', 'three_winter_parr', pa))
pop$add_model(
stage = 'three_winter_parr',
transformation = 'grow',
model = staged_growth_factory('three_winter_parr', jg))
pop$add_model(
stage = 'three_winter_parr',
transformation = 'die',
model = staged_transition_factory('three_winter_parr', 'dead_three_winter_parr', jm))
pop$add_model(
stage = 'three_winter_parr',
transformation = 'age',
model = staged_transition_factory('three_winter_parr', 'four_spring_parr', pa))
## Four plus:
pop$add_model(
stage = 'four_spring_parr',
transformation = 'grow',
model = staged_growth_factory('four_spring_parr', jg))
pop$add_model(
stage = 'four_spring_parr',
transformation = 'die',
model = staged_transition_factory('four_spring_parr', 'dead_four_spring_parr', jm))
pop$add_model(
stage = 'four_spring_parr',
transformation = 'age',
model = staged_transition_factory('four_spring_parr', 'four_summer_parr', pa))
pop$add_model(
stage = 'four_summer_parr',
transformation = 'grow',
model = staged_growth_factory('four_summer_parr', jg))
pop$add_model(
stage = 'four_summer_parr',
transformation = 'die',
model = staged_transition_factory('four_summer_parr', 'dead_four_summer_parr', jm))
pop$add_model(
stage = 'four_summer_parr',
transformation = 'age',
model = staged_transition_factory('four_summer_parr', 'four_autumn_parr', pa))
pop$add_model(
stage = 'four_autumn_parr',
transformation = 'grow',
model = staged_growth_factory('four_autumn_parr', jg))
pop$add_model(
stage = 'four_autumn_parr',
transformation = 'die',
model = staged_transition_factory('four_autumn_parr', 'dead_four_autumn_parr', jm))
pop$add_model(
stage = 'four_autumn_parr',
transformation = 'age',
model = staged_transition_factory('four_autumn_parr', 'four_winter_parr', pa))
pop$add_model(
stage = 'four_winter_parr',
transformation = 'grow',
model = staged_growth_factory('four_winter_parr', jg))
pop$add_model(
stage = 'four_winter_parr',
transformation = 'die',
model = staged_transition_factory('four_winter_parr', 'dead_four_winter_parr', jm))
## Smolting:
pop$add_model(
stage = 'two_spring_parr',
transformation = 'smolt',
model = staged_transition_factory('two_spring_parr', 'two_spring_riverine', js2))
pop$add_model(
stage = 'three_spring_parr',
transformation = 'smolt',
model = staged_transition_factory('three_spring_parr', 'three_spring_riverine', js3))
pop$add_model(
stage = 'four_spring_parr',
transformation = 'smolt',
model = staged_transition_factory('four_spring_parr', 'four_spring_riverine', js4))
pop$add_model(
stage = 'two_spring_riverine',
transformation = 'clear_smolts',
model = staged_transition_factory(
'two_spring_riverine', 'two_spring_riverine_total', pa))
pop$add_model(
stage = 'three_spring_riverine',
transformation = 'clear_smolts',
model = staged_transition_factory(
'three_spring_riverine', 'three_spring_riverine_total', pa))
pop$add_model(
stage = 'four_spring_riverine',
transformation = 'clear_smolts',
model = staged_transition_factory(
'four_spring_riverine', 'four_spring_riverine_total', pa))
################################################################################
################################################################################
## To get everything above this line, one would do:
## data("life_cycle-ATS-smolt")
##
################################################################################
################################################################################
pop$clear()
#save(s2, file='../../data/estimates-ATS-smolt-M1.RData')
#save(envir, file='../../data/environment-ATS-smolt.RData')
save(stages, transformations, envir, pop, file='../../data/life_cycle-ATS-smolt-M2.RData')
library(dodo)
o <- within(data = list(), expr = {
stages = letters
n_bins = rbinom(n=length(letters), size=5, prob=0.3) + 1
minima = rep(0,length(letters))
maxima = rep(100, length(letters))
distr <- new('block_distribution', stages=stages, n_bins=n_bins,
minima=minima, maxima=maxima)
distr_summary <- distr$summary
proje <- new('block_projection', stages=stages, bins=n_bins)
proje_plot <- proje$plot
new_distr <- proje %*% distr
})
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.