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

Merge branch 'exploration_GR3D_process' of...

Merge branch 'exploration_GR3D_process' of gitlab-ssh.irstea.fr:SimAquaLife/GR3D into SpawnerRunAnalysis
parents a956d1f3 d123799b
......@@ -319,24 +319,25 @@
<synchronisationMode>ASYNCHRONOUS</synchronisationMode>
<afterReproductionSeason>SUMMER</afterReproductionSeason>
<maximalSurvivalRate>0.1</maximalSurvivalRate>
<!-- <temperatureEffectSurvivalAfterReproduction class="temperatureEffect.LogitEffect"> -->
<!-- <Tref>19.9</Tref> -->
<!-- <alpha>-.1</alpha> -->
<!-- </temperatureEffectSurvivalAfterReproduction> -->
<temperatureEffectSurvivalAfterReproduction
class="temperatureEffect.NoEffect">
<temperatureEffectSurvivalAfterReproduction class="temperatureEffect.LogitEffect">
<Tref>19.9</Tref>
<alpha>-.1</alpha>
</temperatureEffectSurvivalAfterReproduction>
<!-- <temperatureEffectSurvivalAfterReproduction -->
<!-- class="temperatureEffect.NoEffect"> -->
<!-- </temperatureEffectSurvivalAfterReproduction> -->
</species.SurviveAfterReproduction>
<species.MigrateFromRiverToInshore>
<synchronisationMode>ASYNCHRONOUS</synchronisationMode>
<migrationSeasonToReachInshore>SPRING</migrationSeasonToReachInshore>
<migrationSeasonToReachInshore>SUMMER</migrationSeasonToReachInshore>
<displayFluxesOnConsole>false</displayFluxesOnConsole>
</species.MigrateFromRiverToInshore>
<species.MigrateToOffshore>
<synchronisationMode>ASYNCHRONOUS</synchronisationMode>
<migrationSeasonToReachSummeringOffshore>SPRING</migrationSeasonToReachSummeringOffshore>
<migrationSeasonToReachOffshore>AUTOMN</migrationSeasonToReachOffshore>
<offshoreDestination>WINTERING</offshoreDestination>
</species.MigrateToOffshore>
<species.MigrateBetweenOffshores>
......
......@@ -191,7 +191,7 @@ spawnerSurvivalPostReproductionTempRef <- function(Triver,Tref, coeffa, coeffb){
}
#Dome-shape curve with temperature effect
spawnerSurvivalPostReproductionWithBellCurve <- function(Triver, Tmin, Topt, Tmax, coeffa, coeffb){
spawnerSurvivalPostReproductionWithBellCurve <- function(Triver, Tmin, Topt, Tmax, coeffb){
#P1:
#SpRiverPostSpawn = probSurvAfterRepro/(probSurvAfterRepro + (1 - probSurvAfterRepro)*exp(-coeffLogit*(TemperatureEffect(Triver, Tmin, Topt, Tmax))))
......
......@@ -102,12 +102,15 @@ quantile_spring = nea_presence_temp%>%
summarise(Tmin = min(spring_river_temperature),
Q1 = quantile(spring_river_temperature, 0.01),
Q5 = quantile(spring_river_temperature, 0.05),
Med = median(spring_river_temperature),
Mean = mean(spring_river_temperature),
Q95 = quantile(spring_river_temperature, 0.95),
Q99 = quantile(spring_river_temperature, 0.99),
Tmax = max(spring_river_temperature),.groups = 'drop')
#flextable() %>%
#autofit()
#----------------------------------------------------------------------
#see how many times and which watershed had survival below each quantile
nea_presence_temp %>%
......@@ -131,14 +134,13 @@ nea_presence_temp %>%
freq_out = ((n_occurence_out/n_tot)*100),.groups ='drop') %>%
distinct()
#summarize(n = n_distinct(basin_name))
#-----------------
nea_presence_temp %>%
group_by(obs_1900_1950) %>%
filter(spring_river_temperature > quantile(spring_river_temperature, 0.95)) %>%
group_by(year) %>%
summarize(n = n_distinct(basin_name))
filter(spring_river_temperature > quantile(spring_river_temperature, 0.99)) %>%
group_by(basin_name) %>%
summarize(n = n_distinct(year)) %>%
inner_join(nea_riverBasinFeatures %>% select(basin_name, lat_outlet), by = 'basin_name')
#arrange(desc(n))
#-------------------
......@@ -153,6 +155,25 @@ nea_presence_temp %>%
summarize(n = n())
#arrange(desc(n))
#----------------------
nea_presence_temp %>%
filter(basin_name == 'St. Johns') %>%
ggplot()+
geom_histogram(aes(x = spring_river_temperature > quantile_spring$Q99), position = 'identity',binwidth = 0.2, stat ='count')
#-------------------------------------------------------------
#Do the same for spring and summer temperature combined
#--------------------------------------------------------------
quantile_ss = nea_presence_temp%>%
group_by(obs_1900_1950) %>%
summarise(Tmin = min(c(spring_river_temperature, summer_river_temperature)),
Q1 = quantile(c(spring_river_temperature,summer_river_temperature), 0.01),
Q5 = quantile(c(spring_river_temperature,summer_river_temperature), 0.05),
Med = median(c(spring_river_temperature,summer_river_temperature)),
Mean = mean(c(spring_river_temperature,summer_river_temperature)),
Q95 = quantile(c(spring_river_temperature,summer_river_temperature), 0.95),
Q99 = quantile(c(spring_river_temperature,summer_river_temperature), 0.99),
Tmax = max(c(spring_river_temperature,summer_river_temperature)),.groups = 'drop')
```
......@@ -447,7 +468,7 @@ ToptSurv = TminSurv + lambda *(TmaxSurv - TminSurv)
ggp_A = ggplot() +
geom_line(aes(temperature, temperatureEffect (temperature, res_0A$par['TminSurv'],
geom_line(aes(temperature, temperatureEffect(temperature, res_0A$par['TminSurv'],
Topt = ToptSurv,
res_0A$par['TmaxSurv'])))+
geom_vline(xintercept = c(8,26))
......@@ -468,7 +489,7 @@ ToptSurv = TminSurv + lambda *(TmaxSurv - TminSurv)
ggp_quant = ggplot() +
geom_line(aes(temperature, temperatureEffect (temperature, res_0A_quantile$par['TminSurv'],
geom_line(aes(temperature, temperatureEffect(temperature, res_0A_quantile$par['TminSurv'],
Topt = ToptSurv,
res_0A_quantile$par['TmaxSurv'])))+
geom_vline(xintercept = c(8,26))
......@@ -628,6 +649,8 @@ quantile_sum = nea_presence_temp%>%
summarise(Tmin = min(summer_river_temperature),
Q1 = quantile(summer_river_temperature, 0.01),
Q5 = quantile(summer_river_temperature, 0.05),
Med = median(summer_river_temperature),
Mean = mean(summer_river_temperature),
Q95 = quantile(summer_river_temperature, 0.95),
Q99 = quantile(summer_river_temperature, 0.99),
Tmax = max(summer_river_temperature),.groups = 'drop')
......
......@@ -199,7 +199,7 @@ Stich2020_sel <- read_csv("../NEA_calibration_offline/Stich_Table 9.csv") %>%
filter(parameter == "K" | parameter == "Linf"|parameter == "t0") %>%
dplyr::rename("catchment"="cachtment") %>%
select(parameter,catchment,mean) %>%
pivot_wider(names_from = parameter, values_from = mean) %>%
pivot_wider(names_from = parameter, values_from = mean)
Stich2020_sel %>%
flextable() %>%
......@@ -344,6 +344,8 @@ growthInBasin %>%
distinct(basin_name, obs_1900_1950)
```
As Stich et al 2020 provided a growth curve for both sex combined, we draw a parameters set for unisex based on the growth parameters for males and females from the XML file.
```{r Growth in GR3D with temperature effect, echo = FALSE, warning=FALSE}
#define parameters for both sex based on value from the XML file
......@@ -364,6 +366,7 @@ growParUnisex <- growPar %>%
```{r}
# new ====
#save all file that will be needed for optimization process as SOS data
save(growParUnisex,growthInBasin, nea_presence, Stich2020_sel, file = 'SOS.rdata' )
rm(list = ls())
......@@ -371,7 +374,7 @@ load('SOS.rdata')
source("../GR3D_Rdescription/GR3Dfunction.R")
```
Based on growth curves from Stich et al, 2020, we looked for growth parameters (L0, Linf, Kopt) and the thermal range regulating growth, that minimize the square distance between the mean growth curve derived from Stich et al, 2020 and the growth curve to implemented into the GR3D model for each meta-population.
```{r growth optimisation function Camille, echo = FALSE, warning=FALSE}
#vector on paramters to get optimized
......@@ -482,7 +485,7 @@ par2parGrowth = function(par){
return(parGrowth)
}
# avec Topt, Tmin = Topt - espsilonMinus, Tmax = Topt + epsilonPlus
# with Topt, Tmin = Topt - espsilonMinus, Tmax = Topt + epsilonPlus
objFn = function(par, data) {
growPar = par2parGrowth(par)
data = computeGrowAllBasins(data, growPar)
......@@ -499,7 +502,7 @@ objFn = function(par, data) {
return(SSE)
}
# équivalent de la fonction computeSSE (un peu plus rapide)
# same as computeSSE but faster
objFn_B = function(par, data) {
growPar = enframe(par) %>%
pivot_wider() %>% mutate(sigmaDeltaLVonBert = 0)
......@@ -517,7 +520,7 @@ objFn_B = function(par, data) {
return(SSE)
}
# équivalent de la fonction objFn_B mais avec la possibilité de fixer des parametres
# same as objFn_B with a vector for starting initaila values
objFn_C = function(par, data, fixedPar) {
growPar = enframe(c(par, fixedPar)) %>% pivot_wider() %>%
mutate(sigmaDeltaLVonBert = 0)
......@@ -539,7 +542,7 @@ objFn_C = function(par, data, fixedPar) {
```{r starting parameters for optimisation}
# starting point from XML
vecPar = growParModifed %>%
vecPar = growParUnisex %>%
select(tempMinGrow, tempOptGrow, tempMaxGrow, lengthAtHatching, Linf, kOpt) %>%
pivot_longer(tempMinGrow:kOpt, names_to = "parameter", values_to = "value")
vecPar = as.vector(vecPar$value)
......@@ -593,7 +596,7 @@ dataCalibration = growthInBasin %>%
```
Avec uniqument le jeu de Stich cela part en vrille avec objFn_B et computeSSE ( sans donner les mémes resultats argh) avec Topt < Tmin. On a des résulats corrects avec objFn ( avec Topt +- epsilon). Mais comme on va utiliser l'option en fixant Tmin et Tmax
<!-- Avec uniqument le jeu de Stich cela part en vrille avec objFn_B et computeSSE ( sans donner les mémes resultats argh) avec Topt < Tmin. On a des résulats corrects avec objFn ( avec Topt +- epsilon). Mais comme on va utiliser l'option en fixant Tmin et Tmax -->
```{r optimisation run}
......
......@@ -299,8 +299,8 @@ public class RIOBasinNetworkObserverWithContinent extends ObserverListener
for (DiadromousFishGroup group : basin.getGroups()) {
abundance += basin.getEffective(group);
}
if (basin instanceof RiverBasin & abundance > 0)
System.out.println(" " + basin.getName() + " (" + basin.getClass().getSimpleName() + ") -->" + abundance);
//if (basin instanceof RiverBasin & abundance > 0)
//System.out.println(" " + basin.getName() + " (" + basin.getClass().getSimpleName() + ") -->" + abundance);
if (abundance == 0.) {
g.setColor(Color.WHITE);
......
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