Skip to content

GitLab

Commit 87b7bb9e authored by patrick.lambert's avatar patrick.lambert
Browse files

with a new computeOgive

parent 10525849
Hide whitespace changes
Inline Side-by-side
exploration/GR3D_Rdescription/GR3Dfunction.R
View file @ 87b7bb9e
...@@ -39,6 +39,7 @@ vonBertalanffyInverse = function(L, L0, Linf, K){ ...@@ -39,6 +39,7 @@ vonBertalanffyInverse = function(L, L0, Linf, K){
# von Bertalanffy increment # von Bertalanffy increment
# pas cohérent avec la temperature effet sur le coeff de croissance mais ca marche # pas cohérent avec la temperature effet sur le coeff de croissance mais ca marche
vonBertalanffyIncrement = function(nStep, L0, Linf, K, timeStepDuration, sigma, withTempEffect=FALSE, TrefAtSea = c(9.876946, 13.489854, 15.891487, 11.554104) ){ vonBertalanffyIncrement = function(nStep, L0, Linf, K, timeStepDuration, sigma, withTempEffect=FALSE, TrefAtSea = c(9.876946, 13.489854, 15.891487, 11.554104) ){
tempEffect = temperatureEffect( TrefAtSea , 3, 17, 26) tempEffect = temperatureEffect( TrefAtSea , 3, 17, 26)
L = matrix(nrow = nStep + 1) L = matrix(nrow = nStep + 1)
...@@ -156,8 +157,24 @@ vonBertalanffyWithRandomVector = function(L, Linf, K, timeStepDuration, randomVe ...@@ -156,8 +157,24 @@ vonBertalanffyWithRandomVector = function(L, Linf, K, timeStepDuration, randomVe
return(L) return(L)
} }
computeOgive = function(lengthTrajectories, lengthAtMaturity){
ogive <- lengthTrajectories %>%
group_by(age) %>%
summarise(nTotal = n()) %>%
left_join(lengthTrajectories %>% group_by(age) %>%
filter(L >= lengthAtMaturity) %>%
summarise(taller = n(), .groups = 'drop'),
by = 'age') %>%
replace_na(list(taller = 0)) %>%
mutate(mature = c(0,diff(taller)),
immature = nTotal - cumsum(mature),
p = if_else(mature + immature > 0 , mature / (mature + immature), 1)) %>%
select(age, p)
return(ogive)
}
computeOgive = function(lengthTrajectories, lengthAtMaturity) { # deprecated
computeOgive3 = function(lengthTrajectories, lengthAtMaturity) {
ogive <- ogive <-
lengthTrajectories %>% lengthTrajectories %>%
group_by(age) %>% group_by(age) %>%
......
exploration/NEA_calibration_offline/maturationPL.Rmd
View file @ 87b7bb9e
...@@ -67,130 +67,131 @@ temperaturePattern <- growthInBasin %>% ...@@ -67,130 +67,131 @@ temperaturePattern <- growthInBasin %>%
``` ```
```{r local function} ```{r local function}
# TRENSFERED IN GR3D functiond
# generate a cohort of length trajectories
computeMultipleLengthTrajectories = function(temperaturePattern, Nind = 10, growPar){ # # generate a cohort of length trajectories
ages = temperaturePattern$age # computeMultipleLengthTrajectories = function(temperaturePattern, Nind = 10, growPar){
# ages = temperaturePattern$age
res <- expand_grid(ind = seq.int(Nind), age = ages) %>% #
inner_join(temperaturePattern, by = 'age') %>% # res <- expand_grid(ind = seq.int(Nind), age = ages) %>%
arrange(age, ind) %>% # inner_join(temperaturePattern, by = 'age') %>%
mutate(temperatureEffect = temperatureEffect(temperature, # arrange(age, ind) %>%
growPar$tempMinGrow, # mutate(temperatureEffect = temperatureEffect(temperature,
growPar$tempOptGrow, # growPar$tempMinGrow,
growPar$tempMaxGrow), # growPar$tempOptGrow,
L = if_else(age == 0, growPar$lengthAtHatching, 0)) # growPar$tempMaxGrow),
# L = if_else(age == 0, growPar$lengthAtHatching, 0))
for (i in 2:length(ages)) { #
previousAge = ages[i - 1] # for (i in 2:length(ages)) {
currentAge = ages[i] # previousAge = ages[i - 1]
tempEffect = res %>% filter(age == currentAge) %>% select(temperatureEffect) %>% unlist(use.names = FALSE) # currentAge = ages[i]
previousL <- res %>% filter(age == previousAge) %>% select(L) %>% unlist(use.names = FALSE) # 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, # currentL <- vonBertalanffyWithNextIncrement(L = previousL,
K = growPar$kOpt, # Linf = growPar$Linf,
timeStepDuration = currentAge - previousAge, # K = growPar$kOpt,
sigma = growPar$sigmaDeltaLVonBert, # timeStepDuration = currentAge - previousAge,
tempEffect = tempEffect) # sigma = growPar$sigmaDeltaLVonBert,
res = res %>% mutate(L =replace(L, age == ages[i], currentL) ) # tempEffect = tempEffect)
} # res = res %>% mutate(L =replace(L, age == ages[i], currentL) )
return(res) # }
} # return(res)
# }
computeMultipleLengthTrajectoriesWithRandomSeed = function(temperaturePattern, #
Nind = 10, # computeMultipleLengthTrajectoriesWithRandomSeed = function(temperaturePattern,
growPar, # Nind = 10,
RNGseed =1){ # growPar,
set.seed(RNGseed) # RNGseed =1){
ages = temperaturePattern %>% # set.seed(RNGseed)
distinct(age) %>% # ages = temperaturePattern %>%
unlist(use.names = FALSE) # distinct(age) %>%
# unlist(use.names = FALSE)
res <- expand_grid(ind = seq.int(Nind), age = ages) %>% #
mutate(random = rnorm(Nind * length(ages))) %>% # res <- expand_grid(ind = seq.int(Nind), age = ages) %>%
inner_join(temperaturePattern, by = 'age') %>% # mutate(random = rnorm(Nind * length(ages))) %>%
arrange(age, ind) %>% # inner_join(temperaturePattern, by = 'age') %>%
mutate(temperatureEffect = temperatureEffect(temperature, # arrange(age, ind) %>%
growPar$tempMinGrow, # mutate(temperatureEffect = temperatureEffect(temperature,
growPar$tempOptGrow, # growPar$tempMinGrow,
growPar$tempMaxGrow), # growPar$tempOptGrow,
L = if_else(age == 0, growPar$lengthAtHatching, 0)) # growPar$tempMaxGrow),
# L = if_else(age == 0, growPar$lengthAtHatching, 0))
for (i in 2:length(ages)) { #
previousAge = ages[i - 1] # for (i in 2:length(ages)) {
currentAge = ages[i] # previousAge = ages[i - 1]
tempEffect <- res %>% filter(age == currentAge) %>% # currentAge = ages[i]
select(temperatureEffect) %>% unlist(use.names = FALSE) # tempEffect <- res %>% filter(age == currentAge) %>%
# select(temperatureEffect) %>% unlist(use.names = FALSE)
previousL <- res %>% filter(age == previousAge) %>% #
select(L) %>% unlist(use.names = FALSE) # previousL <- res %>% filter(age == previousAge) %>%
rnd <- res %>% filter(age == currentAge) %>% select(random) %>% unlist(use.names = FALSE) # select(L) %>% unlist(use.names = FALSE)
currentL <- vonBertalanffyWithRandomVector(L = previousL, # rnd <- res %>% filter(age == currentAge) %>% select(random) %>% unlist(use.names = FALSE)
Linf = growPar$Linf, # currentL <- vonBertalanffyWithRandomVector(L = previousL,
K = growPar$kOpt, # Linf = growPar$Linf,
timeStepDuration = currentAge - previousAge, # K = growPar$kOpt,
randomVector = rnd, # timeStepDuration = currentAge - previousAge,
sigma = growPar$sigmaDeltaLVonBert, # randomVector = rnd,
tempEffect = tempEffect) # sigma = growPar$sigmaDeltaLVonBert,
res = res %>% mutate(L = replace(L, age == ages[i], currentL) ) # tempEffect = tempEffect)
} # res = res %>% mutate(L = replace(L, age == ages[i], currentL) )
return(res) # }
} # return(res)
# }
#computeMultipleLengthTrajectoriesWithRandomSeed(temperaturePattern, Nind = 10, #
#growPar = growParUnisex, # #computeMultipleLengthTrajectoriesWithRandomSeed(temperaturePattern, Nind = 10,
# RNGseed = 1) # #growPar = growParUnisex,
# # RNGseed = 1)
vonBertalanffyWithRandomVector = function(L, Linf, K, timeStepDuration, randomVector, sigma, tempEffect ){ #
if (sigma == 0) { # vonBertalanffyWithRandomVector = function(L, Linf, K, timeStepDuration, randomVector, sigma, tempEffect ){
mu = if_else(L < Linf, log((Linf - L) * (1 - exp(-K * tempEffect * timeStepDuration))),-Inf) # if (sigma == 0) {
#mu = log((Linf - L) * (1 - exp(-K * tempEffect * timeStepDuration))) # mu = if_else(L < Linf, log((Linf - L) * (1 - exp(-K * tempEffect * timeStepDuration))),-Inf)
increment = exp(mu) # #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) # else {
# mu = log((Linf - L) * (1 - exp(-K * tempEffect * timeStepDuration))) - (sigma * sigma) / 2 # mu = if_else(L < Linf, log((Linf - L) * (1 - exp(-K * tempEffect * timeStepDuration))) - (sigma * sigma) / 2, -Inf)
increment = exp(randomVector * sigma + mu) # # mu = log((Linf - L) * (1 - exp(-K * tempEffect * timeStepDuration))) - (sigma * sigma) / 2
} # increment = exp(randomVector * sigma + mu)
L = pmin(Linf, L + increment) # }
return(L) # L = pmin(Linf, L + increment)
} # return(L)
# }
#
computeOgive = function(lengthTrajectories, lengthAtMaturity) { #
ogive <- # computeOgive = function(lengthTrajectories, lengthAtMaturity) {
lengthTrajectories %>% # ogive <-
group_by(age) %>% # lengthTrajectories %>%
summarise(nTotal=n()) %>% # group_by(age) %>%
left_join(lengthTrajectories %>% group_by(age) %>% # summarise(nTotal=n()) %>%
filter(L > lengthAtMaturity) %>% # left_join(lengthTrajectories %>% group_by(age) %>%
summarise(mature = n(), .groups = 'drop'), # filter(L > lengthAtMaturity) %>%
by = 'age') %>% # summarise(mature = n(), .groups = 'drop'),
replace_na(list(mature = 0)) %>% # by = 'age') %>%
mutate(p = mature/nTotal) %>% # replace_na(list(mature = 0)) %>%
select(age, p) # mutate(p = mature/nTotal) %>%
# select(age, p)
return(ogive) #
} # return(ogive)
# }
#Deprecated #
computeOgive2 = function(lengthTrajectories, lengthAtMaturity) { # #Deprecated
ogive <- lengthTrajectories %>% # computeOgive2 = function(lengthTrajectories, lengthAtMaturity) {
distinct(age) %>% arrange(age) %>% # ogive <- lengthTrajectories %>%
left_join(lengthTrajectories %>% filter(L > lengthAtMaturity) %>% # distinct(age) %>% arrange(age) %>%
group_by(ind) %>% # left_join(lengthTrajectories %>% filter(L > lengthAtMaturity) %>%
summarise(age = min(age), .groups = 'drop') %>% # group_by(ind) %>%
group_by(age) %>% # summarise(age = min(age), .groups = 'drop') %>%
summarise(mature = n(), .groups = 'drop'), # group_by(age) %>%
by = 'age') %>% # summarise(mature = n(), .groups = 'drop'),
replace_na(list(mature = 0)) %>% # by = 'age') %>%
mutate(immature = sum(mature) - cumsum(mature), # replace_na(list(mature = 0)) %>%
p = if_else(mature + immature == 0, 0, mature/(mature + immature))) %>% # mutate(immature = sum(mature) - cumsum(mature),
select(age, p) # p = if_else(mature + immature == 0, 0, mature/(mature + immature))) %>%
# select(age, p)
return(ogive) #
} # return(ogive)
# }
``` ```
...@@ -632,52 +633,64 @@ SSEforOneMetapop(fullPar = enframe(c(par_0, fixedPar)) %>% pivot_wider(), ...@@ -632,52 +633,64 @@ SSEforOneMetapop(fullPar = enframe(c(par_0, fixedPar)) %>% pivot_wider(),
RNGseed = 1) RNGseed = 1)
toc() toc()
fixedPar0 = c(tempMinGrow = 1.6, #min temperature experienced by fish in the 11 RB from Stich et al, 2020 #
tempMaxGrow = 27.9,#max temperature experienced by fish in the 11 RB from Stich et al, 2020 # fixedPar
lengthAtHatching = 2.8) # res_Abis$par
# avirer # # fixedPar0 = c(tempMinGrow = 1.6, #min temperature experienced by fish in the 11 RB from Stich et al, 2020
parFemale = enframe(c(resA_par, fixedPar0)) %>% pivot_wider() %>% select(tempMinGrow, tempOptGrow, tempMaxGrow, # # tempMaxGrow = 27.9,#max temperature experienced by fish in the 11 RB from Stich et al, 2020
lengthAtHatching, # # lengthAtHatching = 2.8)
Linf = linfVonBert, # # avirer
kOpt = kOptForFemale, # parFemale = enframe(c(res_Abis$par, fixedPar)) %>% pivot_wider() %>% select(tempMinGrow, tempOptGrow, tempMaxGrow,
sigmaDeltaLVonBert, # lengthAtHatching,
lengthAtMaturity = lFirstMaturityForFemale) # Linf = linfVonBert,
# kOpt = kOptForFemale,
# sigmaDeltaLVonBert,
#================================ ICI ======================================= # lengthAtMaturity = lFirstMaturityForFemale)
rm(lengthTrajectories) #
lengthTrajectories = computeMultipleLengthTrajectoriesWithRandomSeed(temperaturePattern = temperaturePattern %>% filter(metapop == "semelparous"), #
Nind = 1000, # #================================ ICI =======================================
growPar = parFemale, # rm(lengthTrajectories)
RNGseed = 1) %>% # lengthTrajectories = computeMultipleLengthTrajectoriesWithRandomSeed(temperaturePattern = temperaturePattern %>% filter(metapop == "semelparous"),
arrange(ind,age) %>% # Nind = 1000,
filter(season == "spring") # growPar = parFemale,
# RNGseed = 1) %>%
# arrange(ind,age) %>%
lengthTrajectories %>% # filter(season == "spring")
ggplot(aes(x = age, y= L, color = as.factor(ind))) + #
geom_path( show.legend = FALSE) #
# lengthTrajectories %>%
# ggplot(aes(x = age, y= L, color = as.factor(ind))) +
lengthTrajectories %>% # geom_path( show.legend = FALSE)
group_by(age) %>% #
summarise(L = mean(L)) %>% #
print(n=Inf) # lengthTrajectories %>%
# group_by(age) %>%
lengthTrajectories %>% # summarise(L = mean(L)) %>%
computeOgive(lengthAtMaturity = parFemale$lengthAtMaturity) %>% # print(n=Inf)
print(n=Inf) #
#
# lengthTrajectories <- computeMultipleLengthTrajectoriesWithRandomSeed(temperaturePattern = temperaturePattern %>% filter(metapop == "semelparous"),
# Nind = 100000,
# growPar = parFemale %>% mutate(sigmaDeltaLVonBert =.6),
vonBertalanffyWithRandomVector(L = c(2.8, 2.8), # RNGseed = 1) %>%
Linf = parFemale$Linf, # arrange(ind,age) %>%
timeStepDuration = 0.25, # filter(season == "spring")
K = parFemale$kOpt, #
randomVector = c(0.184, -0.253), #
sigma = parFemale$sigmaDeltaLVonBert, # lengthTrajectories %>%
tempEffect = c(0.0639, 0.0639)) # computeOgive(lengthAtMaturity = parFemale$lengthAtMaturity) %>%
# print(n=Inf)
#
#
#
#
# vonBertalanffyWithRandomVector(L = c(2.8, 2.8),
# Linf = parFemale$Linf,
# timeStepDuration = 0.25,
# K = parFemale$kOpt,
# randomVector = c(0.184, -0.253),
# sigma = parFemale$sigmaDeltaLVonBert,
# tempEffect = c(0.0639, 0.0639))
``` ```
```{r set parameters values for calibration, warning = "FALSE"} ```{r set parameters values for calibration, warning = "FALSE"}
...@@ -721,14 +734,15 @@ par_0 = c(tempOptGrow = 5, #from optimisation on growth curves ...@@ -721,14 +734,15 @@ par_0 = c(tempOptGrow = 5, #from optimisation on growth curves
kOptForFemale = 0.32, #XML - Alosa alosa kOptForFemale = 0.32, #XML - Alosa alosa
kOptForMale = .21, #XML - Alosa alosa kOptForMale = .21, #XML - Alosa alosa
lFirstMaturityForMale = 40, #XML - Alosa sapidissima lFirstMaturityForMale = 40, #XML - Alosa sapidissima
lFirstMaturityForFemale = 45)#XML - Alosa sapidissima lFirstMaturityForFemale = 45,#XML - Alosa sapidissima
linfVonBert = 76, #XML - Alosa alosa
sigmaDeltaLVonBert = .2) #XML - Alosa alosa
fixedPar = c(tempMinGrow = 1.6, #min temperature experienced by fish in the 11 RB from Stich et al, 2020 fixedPar = c(tempMinGrow = 1.6, #min temperature experienced by fish in the 11 RB from Stich et al, 2020
tempMaxGrow = 27.9,#max temperature experienced by fish in the 11 RB from Stich et al, 2020 tempMaxGrow = 27.9,#max temperature experienced by fish in the 11 RB from Stich et al, 2020
lengthAtHatching = 2.8,# XML - Alosa sapidissima lengthAtHatching = 2.8)# XML - Alosa sapidissima
linfVonBert = 76, #XML - Alosa alosa
sigmaDeltaLVonBert = .2) #XML - Alosa alosa
#optimisation #optimisation
# XML - Alosa sapidissia) # XML - Alosa sapidissia)
......
Markdown is supported
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