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
bcc08e41
Commit
bcc08e41
authored
Apr 20, 2021
by
patrick.lambert
Browse files
new calibration of grow
parent
e3b5329a
Changes
2
Expand all
Hide whitespace changes
Inline
Side-by-side
exploration/GR3D_Rdescription/GR3Dfunction.R
View file @
bcc08e41
...
...
@@ -54,7 +54,7 @@ vonBertalanffyIncrement = function(nStep, L0, Linf, K, timeStepDuration, sigma,
return
(
L
)
}
vonBertalanffyWithNextIncrement
=
function
(
L
,
L0
,
Linf
,
K
,
timeStepDuration
,
sigma
,
tempEffect
){
vonBertalanffyWithNextIncrement
=
function
(
L
,
Linf
,
K
,
timeStepDuration
,
sigma
,
tempEffect
){
if
(
sigma
==
0
)
{
mu
=
log
((
Linf
-
L
)
*
(
1
-
exp
(
-
K
*
timeStepDuration
)))
increment
=
exp
(
mu
)
...
...
@@ -67,6 +67,112 @@ vonBertalanffyWithNextIncrement = function(L, L0, Linf, K, timeStepDuration, sig
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
# see see (Chapman et al., 2007; Holloway et al., 2016)
...
...
exploration/NEA_calibration_offline/maturationPL.Rmd
View file @
bcc08e41
This diff is collapsed.
Click to expand it.
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