Skip to content
GitLab
Menu
Projects
Groups
Snippets
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
SimAquaLife
GR3D
Commits
87b7bb9e
Commit
87b7bb9e
authored
Apr 21, 2021
by
patrick.lambert
Browse files
with a new computeOgive
parent
10525849
Changes
2
Show whitespace changes
Inline
Side-by-side
exploration/GR3D_Rdescription/GR3Dfunction.R
View file @
87b7bb9e
...
...
@@ -39,6 +39,7 @@ vonBertalanffyInverse = function(L, L0, Linf, K){
# von Bertalanffy increment
# 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
)
){
tempEffect
=
temperatureEffect
(
TrefAtSea
,
3
,
17
,
26
)
L
=
matrix
(
nrow
=
nStep
+
1
)
...
...
@@ -156,8 +157,24 @@ vonBertalanffyWithRandomVector = function(L, Linf, K, timeStepDuration, randomVe
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
<-
lengthTrajectories
%>%
group_by
(
age
)
%>%
...
...
exploration/NEA_calibration_offline/maturationPL.Rmd
View file @
87b7bb9e
...
...
@@ -67,130 +67,131 @@ temperaturePattern <- growthInBasin %>%
```
```{r local function}
# TRENSFERED IN GR3D functiond
# 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)
}
#Deprecated
computeOgive2 = function(lengthTrajectories, lengthAtMaturity) {
ogive <- lengthTrajectories %>%
distinct(age) %>% arrange(age) %>%
left_join(lengthTrajectories %>% filter(L > lengthAtMaturity) %>%
group_by(ind) %>%
summarise(age = min(age), .groups = 'drop') %>%
group_by(age) %>%
summarise(mature = n(), .groups = 'drop'),
by = 'age') %>%
replace_na(list(mature = 0)) %>%
mutate(immature = sum(mature) - cumsum(mature),
p = if_else(mature + immature == 0, 0, mature/(mature + immature))) %>%
select(age, p)
return(ogive)
}
#
# 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)
#
}
#
#
#Deprecated
#
computeOgive2 = function(lengthTrajectories, lengthAtMaturity) {
#
ogive <- lengthTrajectories %>%
#
distinct(age) %>% arrange(age) %>%
#
left_join(lengthTrajectories %>% filter(L > lengthAtMaturity) %>%
#
group_by(ind) %>%
#
summarise(age = min(age), .groups = 'drop') %>%
#
group_by(age) %>%
#
summarise(mature = n(), .groups = 'drop'),
#
by = 'age') %>%
#
replace_na(list(mature = 0)) %>%
#
mutate(immature = sum(mature) - cumsum(mature),
#
p = if_else(mature + immature == 0, 0, mature/(mature + immature))) %>%
#
select(age, p)
#
#
return(ogive)
#
}
```
...
...
@@ -632,52 +633,64 @@ SSEforOneMetapop(fullPar = enframe(c(par_0, fixedPar)) %>% pivot_wider(),
RNGseed = 1)
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
lengthAtHatching = 2.8)
# avirer
parFemale = enframe(c(resA_par, fixedPar0)) %>% pivot_wider() %>% select(tempMinGrow, tempOptGrow, tempMaxGrow,
lengthAtHatching,
Linf = linfVonBert,
kOpt = kOptForFemale,
sigmaDeltaLVonBert,
lengthAtMaturity = lFirstMaturityForFemale)
#================================ ICI =======================================
rm(lengthTrajectories)
lengthTrajectories = computeMultipleLengthTrajectoriesWithRandomSeed(temperaturePattern = temperaturePattern %>% filter(metapop == "semelparous"),
Nind = 1000,
growPar = parFemale,
RNGseed = 1) %>%
arrange(ind,age) %>%
filter(season == "spring")
lengthTrajectories %>%
ggplot(aes(x = age, y= L, color = as.factor(ind))) +
geom_path( show.legend = FALSE)
lengthTrajectories %>%
group_by(age) %>%
summarise(L = mean(L)) %>%
print(n=Inf)
lengthTrajectories %>%
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))
#
# fixedPar
# res_Abis$par
# # 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
# # lengthAtHatching = 2.8)
# # avirer
# parFemale = enframe(c(res_Abis$par, fixedPar)) %>% pivot_wider() %>% select(tempMinGrow, tempOptGrow, tempMaxGrow,
# lengthAtHatching,
# Linf = linfVonBert,
# kOpt = kOptForFemale,
# sigmaDeltaLVonBert,
# lengthAtMaturity = lFirstMaturityForFemale)
#
#
# #================================ ICI =======================================
# rm(lengthTrajectories)
# lengthTrajectories = computeMultipleLengthTrajectoriesWithRandomSeed(temperaturePattern = temperaturePattern %>% filter(metapop == "semelparous"),
# Nind = 1000,
# growPar = parFemale,
# RNGseed = 1) %>%
# arrange(ind,age) %>%
# filter(season == "spring")
#
#
# lengthTrajectories %>%
# ggplot(aes(x = age, y= L, color = as.factor(ind))) +
# geom_path( show.legend = FALSE)
#
#
# lengthTrajectories %>%
# group_by(age) %>%
# summarise(L = mean(L)) %>%
# print(n=Inf)
#
#
# lengthTrajectories <- computeMultipleLengthTrajectoriesWithRandomSeed(temperaturePattern = temperaturePattern %>% filter(metapop == "semelparous"),
# Nind = 100000,
# growPar = parFemale %>% mutate(sigmaDeltaLVonBert =.6),
# RNGseed = 1) %>%
# arrange(ind,age) %>%
# filter(season == "spring")
#
#
# lengthTrajectories %>%
# 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"}
...
...
@@ -721,14 +734,15 @@ par_0 = c(tempOptGrow = 5, #from optimisation on growth curves
kOptForFemale = 0.32, #XML - Alosa alosa
kOptForMale = .21, #XML - Alosa alosa
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
tempMaxGrow = 27.9,#max temperature experienced by fish in the 11 RB from Stich et al, 2020
lengthAtHatching = 2.8,# XML - Alosa sapidissima
linfVonBert = 76, #XML - Alosa alosa
sigmaDeltaLVonBert = .2) #XML - Alosa alosa
lengthAtHatching = 2.8)# XML - Alosa sapidissima
#optimisation
# XML - Alosa sapidissia)
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment