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
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)
...
...
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