Commit 450b9397 authored by patrick.lambert's avatar patrick.lambert
Browse files

Rmd for weight of dead basin

Showing with 50 additions and 35 deletions
+50 -35
...@@ -75,7 +75,7 @@ source("GR3Dfunction.R") ...@@ -75,7 +75,7 @@ source("GR3Dfunction.R")
## Baseline ## Baseline
The kernel function presently used in GR3D is only based on basin accessibility (linked to distance between basins) even if a generic formulation including basin attractivity (related to basin size) and fish ability (based on fish lenght) is proposed in @rougier2015. The kernel function presently used in GR3D is only based on basin accessibility (linked to distance between basins) even if a generic formulation including basin attractivity (related to basin size) and fish ability (based on fish length) is proposed in @rougier2015.
The first step is to compute for a departure $j_1$ the weight of each destination basin $j_2$ using: The first step is to compute for a departure $j_1$ the weight of each destination basin $j_2$ using:
...@@ -83,7 +83,7 @@ $$w_{j_1\rightarrow j_2} = \frac {1} {1 + e ^{\alpha_0 + \alpha_1 \cdot {\frac ...@@ -83,7 +83,7 @@ $$w_{j_1\rightarrow j_2} = \frac {1} {1 + e ^{\alpha_0 + \alpha_1 \cdot {\frac
where $D_{j_1\rightarrow j_2}$ is the distance between the departure and destination basins, $\alpha_0$ and $\alpha_1$ are the kernel parameters, $\mu_D$ and $\sigma_D$ are the mean and standard deviation between inter basin distances. where $D_{j_1\rightarrow j_2}$ is the distance between the departure and destination basins, $\alpha_0$ and $\alpha_1$ are the kernel parameters, $\mu_D$ and $\sigma_D$ are the mean and standard deviation between inter basin distances.
The last two parameters were introduced to standardise distance when accessibility is combining with attractivity and ability. When only considering only accessibility, $\mu_D$ and $\sigma_D$ are simply linked to the distance a strayer can reach. There is no need to be changed when the basins network (number and location of basins) change. Definitively the definition as mean and standard deviation of distances is confusing. The last two parameters were introduced to standardise distance when accessibility is combining with attractivity and ability. When only considering only accessibility, $\mu_D$ and $\sigma_D$ are simply linked to the distance a strayer can reach. There is no need to be changed when the basins network (number and location of basins) changes. Definitively, the definition as mean and standard deviation of distances is confusing.
The sum of weights for the departure basin $j_1$ is: $$w_{j_1} = \sum_{j_2 \neq j_1} {w_{j_1\rightarrow j_2}}$$ The sum of weights for the departure basin $j_1$ is: $$w_{j_1} = \sum_{j_2 \neq j_1} {w_{j_1\rightarrow j_2}}$$
...@@ -93,7 +93,7 @@ $$ ...@@ -93,7 +93,7 @@ $$
p_{j_1 \rightarrow j_2} = \frac {w_{j_1 \rightarrow j_2}} {w_{death} + w_{j_1}} p_{j_1 \rightarrow j_2} = \frac {w_{j_1 \rightarrow j_2}} {w_{death} + w_{j_1}}
$$ $$
With these equations, the strayer mortality $sm_{j_1}$ from a departure basin is given by: With these equations, the strayer mortality rate $sm_{j_1}$ from a departure basin is given by:
$$ sm_{ j_1} = \frac {w_{death}} { w_{death}+w_{j_1} }$$ $$ sm_{ j_1} = \frac {w_{death}} { w_{death}+w_{j_1} }$$
...@@ -109,8 +109,11 @@ From the distance grid file used by GR3D for the AA application, the data, after ...@@ -109,8 +109,11 @@ From the distance grid file used by GR3D for the AA application, the data, after
```{r distance, echo =FALSE, warning = FALSE, include = TRUE} ```{r distance, echo =FALSE, warning = FALSE, include = TRUE}
#paged.print=TRUE #paged.print=TRUE
ft <- head(distanceAA,15) %>% flextable() %>% set_formatter_type(fmt_double = "%.02f") %>% autofit() # ft <- head(distanceAA, 15) %>%
set_caption(ft, 'Examples of distance (in km) between departure and destination basins') # flextable() %>%
# set_formatter_type(fmt_double = "%.02f") %>% autofit()
#
# set_caption(ft, 'Examples of distance (in km) between departure and destination basins')
``` ```
...@@ -130,7 +133,9 @@ dataKernel = data.frame(dist = dist, W = logitKernel(dist, alpha0, alpha1, mean ...@@ -130,7 +133,9 @@ dataKernel = data.frame(dist = dist, W = logitKernel(dist, alpha0, alpha1, mean
``` ```
```{r drawKernelFunctionAA, echo =FALSE, warning = FALSE, include = TRUE, fig.cap="Kernel function for AA application"} ```{r drawKernelFunctionAA, echo =FALSE, warning = FALSE, include = TRUE, fig.cap="Kernel function for AA application"}
dataKernel %>% ggplot(aes(x=dist, y=W)) + geom_line() + labs(x='distance between departure and destination basins (km)') dataKernel %>%
ggplot(aes(x=dist, y=W)) + geom_line() +
labs(x = 'distance between departure and destination basins (km)')
``` ```
```{r} ```{r}
...@@ -182,15 +187,17 @@ resultAA <- extendedDistance %>% distinct(departure, sumW) %>% ...@@ -182,15 +187,17 @@ resultAA <- extendedDistance %>% distinct(departure, sumW) %>%
resultAA resultAA
``` ```
```{r, fig.cap="Evolution od} ```{r strayerMortalityAA, fig.cap="Evolution of the mortality rate according to the latitude of the departure basin in the AA zone"}
resultAA %>% ggplot(aes(x=latitude, y=sm_departure)) + geom_point() + labs(x="departure latitude (°)", y = "strayer mortality rate") resultAA %>% ggplot(aes(x = latitude, y = sm_departure)) +
geom_point() +
labs(x = "departure latitude (°)", y = "strayer mortality rate")
``` ```
```{r} ```{r stayerEfficiencyAA, fig.cap="Evolution of the strayers' efficiency according to the latitude of the destination basin in the AA zone"}
resultAA %>% ggplot(aes(x=latitude, y=se_destination)) + geom_point() + labs(x="destination latitude (°)", y = "strayer efficiency") resultAA %>% ggplot(aes(x = latitude, y = se_destination)) + geom_point() + labs(x="destination latitude (°)", y = "strayer efficiency")
``` ```
## North East America application ## North East America NEA application
```{r computeDistanceFeatures} ```{r computeDistanceFeatures}
# meanInterDistance <- mean(distanceNEA$distance, na.rm = TRUE ) # meanInterDistance <- mean(distanceNEA$distance, na.rm = TRUE )
...@@ -229,21 +236,23 @@ resultNEA <- extendedDistance %>% distinct(departure, sumW) %>% ...@@ -229,21 +236,23 @@ resultNEA <- extendedDistance %>% distinct(departure, sumW) %>%
rename(latitude = lat_outlet) rename(latitude = lat_outlet)
``` ```
```{r, fig.cap="Evolution of strayer's mortality according to depature basin latitude in the NEA zone"}
resultNEA %>% ggplot(aes(x=latitude, y=sm_departure)) + ```{r, fig.cap="Evolution of strayers mortality according to depature basin latitude in the NEA zone"}
geom_point() + labs(x="departure latitude (°)", y = "strayer mortality rate") resultNEA %>% ggplot(aes(x = latitude, y = sm_departure)) +
``` geom_point() + labs(x = "departure latitude (°)", y = "strayer mortality rate")
```{r, fig.cap="Evolution of strayer's efficiency according to destination basin latitude in the NEA zone"}
resultNEA %>% ggplot(aes(x=latitude, y=se_destination)) +
geom_point() + labs(x="destination latitude (°)", y = "strayer's efficiency")
``` ```
```{r, fig.cap="Evolution of strayers efficiency according to destination basin latitude in the NEA zone"}
resultNEA %>% ggplot(aes(x = latitude, y = se_destination)) +
geom_point() + labs(x = "destination latitude (°)", y = "strayer's efficiency")
# geom_text(aes(label = basin_name), hjust = 0, nudge_x = 0.5)
```
## Virtual linear network of basin ## Virtual linear network of basin
### full universe ### full universe
```{r fake list of basin, echo false, include = TRUE} ```{r fakeListOfBasin}
nbBasin = 150 nbBasin = 150
distBetweenBasin = 10 distBetweenBasin = 10
# create a fake basin tibble # create a fake basin tibble
...@@ -260,23 +269,27 @@ basinDistance <- tibble(departure = basin$basin_name, destination =basin$basin_n ...@@ -260,23 +269,27 @@ basinDistance <- tibble(departure = basin$basin_name, destination =basin$basin_n
# compute sumW an p12 # compute sumW an p12
extendedDistance = basinDistance %>% extendedDistance = basinDistance %>%
inner_join(basinDistance %>% group_by(departure ) %>% inner_join(basinDistance %>% group_by(departure ) %>%
summarise(sumW = sum(W, na.rm = TRUE), .groups = 'drop'), by='departure') %>% summarise(sumW = sum(W, na.rm = TRUE), .groups = 'drop'), by='departure') %>%
mutate(p12 = W/(sumW + WDeathBasin)) mutate(p12 = W/(sumW + WDeathBasin))
``` ```
```{r sm_fakeUniverse, fig.cap="Evolution of strayer mortality according to latitude departure" }
```{r sm_fakeUniverse, include = TRUE, fig.cap="Evolution of strayer mortality according to latitude departure" }
extendedDistance %>% distinct(departure, latitude_departure, sumW) %>% extendedDistance %>% distinct(departure, latitude_departure, sumW) %>%
mutate(sm_departure = WDeathBasin /(WDeathBasin + sumW)) %>% mutate(sm_departure = WDeathBasin /(WDeathBasin + sumW)) %>%
ggplot(aes(x=latitude_departure, y = sm_departure)) + geom_point() + labs(x='latitude rank', y = 'strayer mortality rate') + ggplot(aes(x=latitude_departure, y = sm_departure)) + geom_point() + labs(x='latitude rank', y = 'strayer mortality rate') +
xlim(0,150) + ylim(0.0,.050) xlim(0,150) + ylim(0.0,.050)
``` ```
```{r se_fakeUniverse, fig.cap="Evolution of strayer efficiency according to latitude departure" } ```{r se_fakeUniverse, include = TRUE, fig.cap="Evolution of strayer efficiency according to departure latitude " }
extendedDistance %>% group_by(destination, latitude_destination) %>% summarise(se_destination = mean(p12), .groups ='drop') %>% extendedDistance %>%
ggplot(aes(x=latitude_destination, y = se_destination)) + geom_point() + labs(x='latitude rank', y = 'strayer efficiency') + group_by(destination, latitude_destination) %>%
summarise(se_destination = mean(p12), .groups ='drop') %>%
ggplot(aes(x=latitude_destination, y = se_destination)) +
geom_point() + labs(x = 'latitude rank', y = 'strayer efficiency') +
xlim(0,150) + ylim(0.0,.010) xlim(0,150) + ylim(0.0,.010)
``` ```
###Sampled universe ### Sampled universe
```{r irregular sampling of fake universe, echo FALSE} ```{r irregular sampling of fake universe, echo FALSE}
sampledBasin <- basin %>% sample_n(25) %>% arrange(latitude) sampledBasin <- basin %>% sample_n(25) %>% arrange(latitude)
...@@ -287,25 +300,27 @@ sampledBasinDistance <- basinDistance %>% inner_join(sampledBasin %>% select(bas ...@@ -287,25 +300,27 @@ sampledBasinDistance <- basinDistance %>% inner_join(sampledBasin %>% select(bas
# compute sumW an p12 # compute sumW an p12
extendedSampledDistance = sampledBasinDistance %>% extendedSampledDistance = sampledBasinDistance %>%
inner_join(sampledBasinDistance %>% group_by(departure ) %>% inner_join(sampledBasinDistance %>% group_by(departure ) %>%
summarise(sumW = sum(W, na.rm = TRUE), .groups = 'drop'), by='departure') %>% summarise(sumW = sum(W, na.rm = TRUE), .groups = 'drop'), by='departure') %>%
mutate(p12 = W/(sumW + WDeathBasin)) mutate(p12 = W / (sumW + WDeathBasin))
``` ```
```{r sm_sampledUniverse, fig.cap="Evolution of strayer mortality according to latitude departure" }
```{r sm_sampledUniverse, include = TRUE, fig.cap="Evolution of strayer mortality according to latitude departure" }
extendedSampledDistance %>% distinct(departure, latitude_departure, sumW) %>% extendedSampledDistance %>% distinct(departure, latitude_departure, sumW) %>%
mutate(sm_departure = WDeathBasin /(WDeathBasin + sumW)) %>% mutate(sm_departure = WDeathBasin /(WDeathBasin + sumW)) %>%
ggplot(aes(x=latitude_departure, y = sm_departure)) + geom_point() + labs(x='latitude rank', y = 'strayer mortality rate') + ggplot(aes(x=latitude_departure, y = sm_departure)) + geom_point() + labs(x='latitude rank', y = 'strayer mortality rate') +
xlim(0,150) + ylim(0.0,.2) xlim(0,150) + ylim(0.0,.2)
``` ```
```{r se_SampledUniverse, fig.cap="Evolution of strayer efficiency according to latitude departure" } ```{r se_SampledUniverse, include = TRUE, fig.cap="Evolution of strayer efficiency according to latitude departure" }
extendedSampledDistance %>% group_by(destination, latitude_destination) %>% extendedSampledDistance %>% group_by(destination, latitude_destination) %>%
summarise(se_destination = mean(p12), .groups ='drop') %>% summarise(se_destination = mean(p12), .groups ='drop') %>%
ggplot(aes(x=latitude_destination, y = se_destination)) + geom_point() + labs(x='latitude rank', y = 'strayer efficiency') + ggplot(aes(x=latitude_destination, y = se_destination)) + geom_point() + labs(x = 'latitude rank', y = 'strayer efficiency') +
xlim(0,150) + ylim(0.0,0.1) xlim(0,150) + ylim(0.0,0.1)
``` ```
# Comparison with HADiaD formulation
```{r echo =TRUE} # Comparison with HaDiaD formulation
```{r HaDiaD, include = TRUE}
alpha_D = 0.0608 alpha_D = 0.0608
beta_D = 0.655 beta_D = 0.655
m = -log(0.464)/41 m = -log(0.464)/41
......
Supports Markdown
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