Commit bcc08e41 authored by patrick.lambert's avatar patrick.lambert
Browse files

new calibration of grow

No related merge requests found
Showing with 659 additions and 77 deletions
+659 -77
...@@ -54,7 +54,7 @@ vonBertalanffyIncrement = function(nStep, L0, Linf, K, timeStepDuration, sigma, ...@@ -54,7 +54,7 @@ vonBertalanffyIncrement = function(nStep, L0, Linf, K, timeStepDuration, sigma,
return(L) return(L)
} }
vonBertalanffyWithNextIncrement = function(L, L0, Linf, K, timeStepDuration, sigma, tempEffect ){ vonBertalanffyWithNextIncrement = function(L, Linf, K, timeStepDuration, sigma, tempEffect ){
if (sigma == 0) { if (sigma == 0) {
mu = log((Linf - L) * (1 - exp(-K * timeStepDuration))) mu = log((Linf - L) * (1 - exp(-K * timeStepDuration)))
increment = exp(mu) increment = exp(mu)
...@@ -67,6 +67,112 @@ vonBertalanffyWithNextIncrement = function(L, L0, Linf, K, timeStepDuration, sig ...@@ -67,6 +67,112 @@ vonBertalanffyWithNextIncrement = function(L, L0, Linf, K, timeStepDuration, sig
return(L) return(L)
} }
# generate a cohort of length trajectories
computeMultipleLengthTrajectories = function(temperaturePattern, Nind = 10, growPar){
ages = temperaturePattern$age
res <- expand_grid(ind = seq.int(Nind), age = ages) %>%
inner_join(temperaturePattern, by = 'age') %>%
arrange(age, ind) %>%
mutate(temperatureEffect = temperatureEffect(temperature,
growPar$tempMinGrow,
growPar$tempOptGrow,
growPar$tempMaxGrow),
L = if_else(age == 0, growPar$lengthAtHatching, 0))
for (i in 2:length(ages)) {
previousAge = ages[i - 1]
currentAge = ages[i]
tempEffect = res %>% filter(age == currentAge) %>% select(temperatureEffect) %>% unlist(use.names = FALSE)
previousL <- res %>% filter(age == previousAge) %>% select(L) %>% unlist(use.names = FALSE)
currentL <- vonBertalanffyWithNextIncrement(L = previousL,
Linf = growPar$Linf,
K = growPar$kOpt,
timeStepDuration = currentAge - previousAge,
sigma = growPar$sigmaDeltaLVonBert,
tempEffect = tempEffect)
res = res %>% mutate(L =replace(L, age == ages[i], currentL) )
}
return(res)
}
computeMultipleLengthTrajectoriesWithRandomSeed = function(temperaturePattern,
Nind = 10,
growPar,
RNGseed =1){
set.seed(RNGseed)
ages = temperaturePattern %>%
distinct(age) %>%
unlist(use.names = FALSE)
res <- expand_grid(ind = seq.int(Nind), age = ages) %>%
mutate(random = rnorm(Nind * length(ages))) %>%
inner_join(temperaturePattern, by = 'age') %>%
arrange(age, ind) %>%
mutate(temperatureEffect = temperatureEffect(temperature,
growPar$tempMinGrow,
growPar$tempOptGrow,
growPar$tempMaxGrow),
L = if_else(age == 0, growPar$lengthAtHatching, 0))
for (i in 2:length(ages)) {
previousAge = ages[i - 1]
currentAge = ages[i]
tempEffect <- res %>% filter(age == currentAge) %>%
select(temperatureEffect) %>% unlist(use.names = FALSE)
previousL <- res %>% filter(age == previousAge) %>%
select(L) %>% unlist(use.names = FALSE)
rnd <- res %>% filter(age == currentAge) %>% select(random) %>% unlist(use.names = FALSE)
currentL <- vonBertalanffyWithRandomVector(L = previousL,
Linf = growPar$Linf,
K = growPar$kOpt,
timeStepDuration = currentAge - previousAge,
randomVector = rnd,
sigma = growPar$sigmaDeltaLVonBert,
tempEffect = tempEffect)
res = res %>% mutate(L = replace(L, age == ages[i], currentL) )
}
return(res)
}
#computeMultipleLengthTrajectoriesWithRandomSeed(temperaturePattern, Nind = 10,
#growPar = growParUnisex,
# RNGseed = 1)
vonBertalanffyWithRandomVector = function(L, Linf, K, timeStepDuration, randomVector, sigma, tempEffect ){
if (sigma == 0) {
mu = if_else(L < Linf, log((Linf - L) * (1 - exp(-K * tempEffect * timeStepDuration))),-Inf)
#mu = log((Linf - L) * (1 - exp(-K * tempEffect * timeStepDuration)))
increment = exp(mu)
}
else {
mu = if_else(L < Linf, log((Linf - L) * (1 - exp(-K * tempEffect * timeStepDuration))) - (sigma * sigma) / 2, -Inf)
# mu = log((Linf - L) * (1 - exp(-K * tempEffect * timeStepDuration))) - (sigma * sigma) / 2
increment = exp(randomVector * sigma + mu)
}
L = pmin(Linf, L + increment)
return(L)
}
computeOgive = function(lengthTrajectories, lengthAtMaturity) {
ogive <-
lengthTrajectories %>%
group_by(age) %>%
summarise(nTotal=n()) %>%
left_join(lengthTrajectories %>% group_by(age) %>%
filter(L > lengthAtMaturity) %>%
summarise(mature = n(), .groups = 'drop'),
by = 'age') %>%
replace_na(list(mature = 0)) %>%
mutate(p = mature/nTotal) %>%
select(age, p)
return(ogive)
}
# ------------------------------------------------------- # -------------------------------------------------------
# Dispersal # Dispersal
# see see (Chapman et al., 2007; Holloway et al., 2016) # see see (Chapman et al., 2007; Holloway et al., 2016)
......
This diff is collapsed.
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment