Commit 37745756 authored by Poulet Camille's avatar Poulet Camille
Browse files

Graphics

parent f23c7a16
......@@ -2,16 +2,17 @@ library(tidyverse)
#TODO extract from xml
thermalRange = tibble(process = "Grow", Tmin = 1.7, Topt = 4.5, Tmax = 27.9, type = "Rosso") %>%
bind_rows(tibble(process = "SurvivalSpawnerInRiv", Tmin = 5.4, Topt = 16.7, Tmax = 27.5, type = "Rosso") ) %>%
bind_rows(tibble(process = "Reproduction", Tmin = 5.1, Topt = 13.5, Tmax = 24.5, type = "Rosso") ) %>%
bind_rows(tibble(process = "SurviveAfterReproduction", Tmin = -Inf, Topt = 19.58 - log(19)/0.58, Tmax = 19.58 + log(19)/0.58, type = "logit") )
thermalRange = tibble(process = "Grow", Tmin = 1.7, Topt = 13.37, Tmax = 27.9, type = "Rosso") %>%
bind_rows(tibble(process = "Spawner_survival_before_reproduction", Tmin = 5.4, Topt = 16.7, Tmax = 27.5, type = "Rosso") ) %>%
bind_rows(tibble(process = "Early-stage_survival", Tmin = 5.1, Topt = 13.5, Tmax = 24.3, type = "Rosso") ) %>%
bind_rows(tibble(process = "Spawner_survival_after_reproduction", Tmin = -Inf, Topt = 19.58 - log(19)/0.58, Tmax = 19.58 + log(19)/0.58, type = "logit") )
thermalRange %>% mutate(numero = row_number(),
process = factor(process,
levels = c("Grow","SurvivalSpawnerInRiv", "SurviveAfterReproduction", "Reproduction" ))) %>%
levels = c("Grow","Spawner_survival_before_reproduction", "Spawner_survival_after_reproduction", "Early-stage_survival" ))) %>%
ggplot() +
geom_segment(aes(x = Tmin, y = process, xend = Tmax, yend = process)) +
geom_point(aes(x = Topt, y = process))
geom_point(aes(x = Topt, y = process))+
labs(title = '', x = "Temperature (°C) ", y = 'Process')
......@@ -381,19 +381,24 @@ plot(temperature,spawnerSurvivalPostReproductionTempRef(temperature,TrefSpring,
plot(temperature, spawnerSurvivalPostReproductionTempRef(temperature,
TrefSummer,
0.19,
0.20), col = "#FF0000")
1,
0.10),
type = "l",
col = "#FF6600",
xlab = "Temperature (°C)",
ylab = "Spawner survival in river",
main = "Spawner Survival after reproduction")
lines(temperature, spawnerSurvivalPostReproductionTempRef(temperature,
ToptSpring,
1.,
0.1), col = "#FF3399")
lines(temperature, spawnerSurvivalPostReproductionTempRef(temperature,
ToptSummer,
1.,
0.1), col = "pink")
# lines(temperature, spawnerSurvivalPostReproductionTempRef(temperature,
# ToptSpring,
# 1.,
# 0.1), col = "#FF3399")
# lines(temperature, spawnerSurvivalPostReproductionTempRef(temperature,
# ToptSummer,
# 1.,
# 0.1), col = "pink")
lines(temperature,spawnerSurvivalPostReproductionTempRiver(temperature,
1,
0.1),col = "blue")
......
......@@ -342,6 +342,38 @@ growthInBasin %>%
growthInBasin %>%
filter(temperature_RIO < 1.6) %>%
distinct(basin_name, obs_1900_1950)
#----------------------------- NEW GRAPH WITH TEMP EFFECT IN THE 11 RIVERS FROM STICH
growthInBasin_2 = growthInBasin %>%
mutate(temp_ref = case_when(
age == 0.00|age == 0.25 ~ "river",
age == 0.50 ~ "inshore",
TRUE~ as.character("offshore"))) %>%
arrange(age,season)
growthInBasin_2 = growthInBasin_2 %>%
mutate(temp_ref_basin = case_when(
temp_ref =="offshore" & season =="summer" ~ "summering_offshore",
temp_ref =="offshore" & season =="fall" ~ "summering_offshore",
temp_ref =="offshore" & season =="winter" ~ "wintering_offshore",
temp_ref == "offshore" & season =="spring" ~ "wintering_offshore",
temp_ref == "inshore" ~ "inshore",
temp_ref =="river"~ "river"))
growthInBasin_2 %>%
inner_join(Stich2020_sel %>% select(basin_name), by ='basin_name') %>%
filter(obs_1900_1950 == 1) %>%
inner_join(nea_riverBasinFeatures %>% select(basin_name,basin_id,lat_outlet), by = c('basin_name' = 'basin_name')) %>%
mutate(basin_name = fct_reorder(basin_name,lat_outlet)) %>%
ggplot(aes(x = temperature_RIO, y = basin_name), show.legend = FALSE) +
geom_path(show.legend = FALSE) +
geom_label((aes(label = str_to_title(str_sub(season,1,2)), fill = temp_ref_basin)), colour = "white",size = 2, show.legend = TRUE)+
scale_fill_manual(values= c("lightblue","blue","orange","purple"), levels(growthInBasin_2$temp_ref_basin))+
labs(title = '', x = "Average seasonal temperature (°C) ", y = 'River Basins')
```
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.
......
library(tydiverse)
library(dplyr)
#x50 = Tref
#x5 = 25°C, ie the temperature above which there is no spanwer survival after reproduction (based on Limbrug et al, 2003)
......@@ -29,7 +30,7 @@ parLogit = c(Tref = 19.9, minTempForIteroparity = 25)
optim_logit2_fn <- function(par,temperature, target, logitPar){
survival = logit2(temp = temperature, Tref = logitPar['Tref'],
survival = logit2(Triver= temperature, Tref = logitPar['Tref'],
minTempForIteroparity = logitPar['minTempForIteroparity']) * par[1]
squareDistance = (mean(survival) - target)^2
......@@ -48,6 +49,66 @@ optim_logit2 <- optim(c(coeffb = 0.2),
logitPar = parLogit,
method = "L-BFGS-B")
#--------------------- compute survival after reproduction
tempInriverAvg = tempInriver %>%
filter(between(year, 1900, 1950)) %>%
group_by(basin_id, basin_name) %>%
mutate(spring_avg = mean(spring_river_temperature),
summer_avg = mean(summer_river_temperature),
fall_avg = mean(fall_river_temperature),
winter_avg = mean(winter_river_temperature))
survivalAfterReproductionByYearInSummer <- tempInriverAvg %>%
mutate(survival = (logit2(summer_river_temperature,Tref = 19.9,minTempForIteroparity = 25) * 0.18))
survivalAfterReproductionByYearInSummer = survivalAfterReproductionByYearInSummer %>%
right_join(nea_riverBasinFeatures %>% select(basin_name,lat_outlet), by = "basin_name") %>%
arrange(lat_outlet) %>%
mutate(metapop = case_when
(lat_outlet <=33.8 ~ "Semelparous",
lat_outlet >33.8 & lat_outlet <= 41.28793 ~ "SouthIteroparous",
lat_outlet > 41.28793 ~ "NorthIteroparous")) %>%
group_by(basin_name) %>%
mutate(mean_surv = mean(survival))
survivalAfterReproductionByYearInSummer%>%
filter(basin_name %in% basinSel) %>%
group_by(basin_name) %>%
summarize(meanTemp = mean(summer_river_temperature))
survivalAfterReproductionByYearInSummer%>%
filter(basin_name %in% basinSel) %>%
select(basin_name,metapop) %>%
distinct()
#plot
survivalAfterReproductionByYearInSummer%>%
filter(basin_name %in% basinSel) %>%
#mutate(year = as.factor(year)) %>%
#filter(metapop == "Semelparous") %>%
ggplot(aes(fct_reorder(basin_name, lat_outlet), survival, color = year))+
#geom_line(aes(spring_avg, sp_spg), col = "orange")+
#geom_line(aes(spring_avg, sp_sum), col = "red")+
#geom_line(aes(spring_avg,surv))+
geom_jitter() +
geom_point(aes(basin_name,mean_surv), col = 'red')+
# geom_text(data = survivalBeforeReproduction_long %>% filter(basin_name %in% basinSel), aes(label = basin_name, color = metapop), size = 3, check_overlap = TRUE)+
# labs(x = "Mean river temperature (°C)",
# y = "Spawner survival before reproduction (100 spawners)") +
#facet_wrap(~surv_type, nrow = 2, ncol = 3)+
theme(axis.text.x = element_text(angle = 90, size = 12),
axis.text.y = element_text(size = 12))+
#geom_hline(yintercept = 0.20, col ="red")+
xlab('Basin name (ordered along a latitudinal gradient)')+
ylab('Spawner survival after reproduction')
......
......@@ -85,6 +85,8 @@ For a deeper explanation on how the mean age for male and female was computed, s
```{r American shad maturity at-age- observed by region and sex using the mortality correction approach (ASMFC, 2020), include = TRUE }
#vector including the 3 regional metapopulation
regional_metapop = c("semelparous", "southern iteroparous", "northern iteroparous")
#American shad maturity at-age- observed by region and sex using the mortality correction approach (ASMFC, 2020)
ogivesObs = expand_grid(age = seq.int(9), metapop = regional_metapop) %>%
arrange(metapop, age) %>%
......@@ -102,10 +104,6 @@ ogivesObs = expand_grid(age = seq.int(9), metapop = regional_metapop) %>%
#1. Observation of growth curves (ASMFC, 2020)
```{r load growth parameters and temperature pattern }
#vector including the 3 regional metapopulation
regional_metapop = c("semelparous", "southern iteroparous", "northern iteroparous")
#Growth parameters from Stich et al, 2020
growParStich <- Stich2020_sel %>%
filter(catchment %in% regional_metapop) %>%
......@@ -153,8 +151,23 @@ In early spring, juveniles and sub-adults then move to one of the three ‘summe
To account for differences in temperatures experienced by fish to growth, we use the seasonal migration timing describe above.
```{r}
rectTemperature = function(Tmin = 3, Topt = 17, Tmax = 27, pct = 0.8, col ='red'){
optRange = thermalRange(pct, Tmin , Topt, Tmax)
rect = data.frame(xmin = c(-Inf, Tmin, optRange["upper"], Tmax),
xmax = c(Tmin, optRange["lower"], Tmax, Inf),
ymin = -Inf,
ymax = Inf,
alpha = c(.3,.6,.6,.3),
col = c(col, 'grey', 'grey', col))
return(rect)
}
```
```{r load temperature pattern }
#Temperature pattern relative to thermal conditions experienced by fish
temperature = seq(-10,35,0.1)
temperaturePattern <- growthInBasin %>%
group_by(metapop, age, season) %>%
summarise(temperature = mean(temperature_RIO), .groups = 'drop') %>%
......@@ -167,6 +180,24 @@ temperaturePattern <- growthInBasin %>%
# )) %>%
select(metapop,age, season,temperature)
parTemperatureGrow = c(Tmin = 1.7, Topt = 13.37, Tmax = 27.9)
rectNew = rectTemperature(Tmin = parTemperatureGrow["Tmin"],
Topt = parTemperatureGrow["Topt"],
Tmax = parTemperatureGrow["Tmax"], col = 'blue')
data.frame(temperature = seq(-5,30, length.out = 100)) %>%
mutate(effect = temperatureEffect(temperature,
Tmin = parTemperatureGrow["Tmin"],
Topt = parTemperatureGrow["Topt"],
Tmax = parTemperatureGrow["Tmax"])) %>%
ggplot(aes(x = temperature, y = effect)) +
geom_line()+
labs(title = '', x = "Temperature (°C) ", y = 'Effect')+
annotate("rect", xmin = rectNew$xmin, xmax = rectNew$xmax, ymin = rectNew$ymin, ymax = rectNew$ymax, alpha = rectNew$alpha, fill = rectNew$col)
```
#3. Optimization of growth and maturity
......
......@@ -70,6 +70,11 @@ factorialPlan = gen.factorial(levels = c(3,2,3,3), nVars=4, varNames = c("meanDi
desFactorial = optFederov(~.,factorialPlan)
desFactorial$design
#fractional factorial 2*2 workshop
factorialPlanTry = gen.factorial(levels = c(2,2), nVars=2, varNames = c("pHoming","alleeEffect")) %>%
flextable() %>%
autofit()
#orthogonal design with Federov algorythm
desOrthogonal = optFederov(~.,factorialPlan,nRepeats=20)
......
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