Skip to content
GitLab
Commit 458ef3c4 authored by patrick.lambert's avatar patrick.lambert
Browse files

Rmd death basin weight

parent 428f6f9c
exploration_GR3D_process SpawnerRunAnalysis develop v3.2.1.b V3.2.1.a
No related merge requests found
Hide whitespace changes
Inline Side-by-side
Showing
with 192 additions and 100 deletions
+192 -100
exploration/GR3D_Rdescription/deathBasinW.Rmd
+ 192
− 100
View file @ 458ef3c4
...@@ -34,6 +34,9 @@ library(knitr) ...@@ -34,6 +34,9 @@ library(knitr)
library(flextable) library(flextable)
library(bookdown) library(bookdown)
library(stringr) library(stringr)
library(purrr)
``` ```
```{r load data} ```{r load data}
...@@ -69,9 +72,16 @@ riverBasinsNEA = read.csv("../../data/input/northeastamerica/nea_riverbasins.cs ...@@ -69,9 +72,16 @@ riverBasinsNEA = read.csv("../../data/input/northeastamerica/nea_riverbasins.cs
# nameRiver %>% setdiff(nameDistance) # nameRiver %>% setdiff(nameDistance)
# nameDistance %>% setdiff(nameRiver) # nameDistance %>% setdiff(nameRiver)
# riverAARougier2015 = read.csv("basinsRougieretal2015.csv", stringsAsFactors = FALSE) %>% # Rougier at al 2015 application
# rename(basin_id = id, basin_name = nomBV) %>% riverAARougier2015 = read.csv("basinsRougieretal2015.csv", stringsAsFactors = FALSE) %>%
# mutate(basin_name =replace(basin_name, basin_name == "Sevre_Niortaise", "Sevre Niortaise")) rename(basin_id = id, basin_name = nomBV) %>%
mutate(basin_name =replace(basin_name, basin_name == "Sevre_Niortaise", "Sevre Niortaise"))
distanceAARougier2015 <- as.matrix(read.csv("distanceGridRougieretal2015.csv", row.names = 1, stringsAsFactors = FALSE)) %>%
as.data.frame() %>% mutate(destination = colnames(.)) %>%
pivot_longer(cols = -destination, names_to = 'departure', values_to = 'distance') %>%
mutate(distance = replace(distance, destination == departure, NA)) %>%
arrange(departure, distance)
``` ```
...@@ -84,7 +94,7 @@ source("GR3Dfunction.R") ...@@ -84,7 +94,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 length) 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 attractiveness (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:
...@@ -92,17 +102,15 @@ $$w_{j_1\rightarrow j_2} = \frac {1} {1 + e ^{\alpha_0 + \alpha_1 \cdot {\frac ...@@ -92,17 +102,15 @@ $$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) changes. 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 attractiveness and ability. When only considering only accessibility, $\mu_D$ and $\sigma_D$ are simply linked to the distance strayer can reach. There is no need to be changed when the basins network (number and location of basins) changes. Definitely, 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}}$$
A strayers' mortality is added by considering a "death basin" with a constant weight $w_{death}$. The probability $p_{j_1 \rightarrow j_2}$ for a strayer to reach a destination basin $j_2$ from departure basin $j_1$ is A strayers mortality is added by considering a "death basin" with a constant weight $w_{death}$. The probability $p_{j_1 \rightarrow j_2}$ for strayer to reach a destination basin $j_2$ from the departure basin $j_1$ is
$$ $$
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}}
$$ $$ \#\# Two metrics to qualify the straying The strayers mortality rate $sm_{j_1}$ from a departure basin calculate the portion of fish that ends in the death basin. It is given by:
## Two metrics to qualify the straying
The strayers mortality rate $sm_{j_1}$ from a departure basin caculate the portion of fish that ends in the death basin. It 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} }$$
...@@ -114,72 +122,71 @@ $$ ...@@ -114,72 +122,71 @@ $$
## Atlantic area application ## Atlantic area application
From the distance grid file used by GR3D for the AA application, the data, after reshaping, look like
```{r distance, echo =FALSE, warning = FALSE, include = TRUE}
#paged.print=TRUE
# ft <- head(distanceAA, 15) %>%
# flextable() %>%
# set_formatter_type(fmt_double = "%.02f") %>% autofit()
#
# set_caption(ft, 'Examples of distance (in km) between departure and destination basins')
```
```{r} ```{r}
alpha0 = -2.9 alpha0 = -2.9
alpha1 = 19.7 alpha1 = 19.7
meanInterDistance = 300 meanInterDistance = 300
standardDeviationInterDistance = 978 standardDeviationInterDistance = 978
WDeathBasin = .4 WDeathBasinRougier2005 = .4
``` ```
The kernel parameters for Atlantic Area application defined by @rougier2015 were $\alpha_0$ = `r alpha0`, $\alpha_1$ = `r alpha1`, $\mu_D$ = `r meanInterDistance` km and $\sigma_D$ = `r standardDeviationInterDistance` km. The death basin weight was $r$ = `r WDeathBasin`. The kernel parameters for Atlantic Area application defined by @rougier2015 were $\alpha_0$ = `r alpha0`, $\alpha_1$ = `r alpha1`, $\mu_D$ = `r meanInterDistance` km and $\sigma_D$ = `r standardDeviationInterDistance` km. The death basin weight was $r$ = `r WDeathBasinRougier2005`.
```{r}
dist = seq(1,500, 10)
dataKernel = data.frame(dist = dist, W = logitKernel(dist, alpha0, alpha1, meanInterDistance, standardDeviationInterDistance))
```
```{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 %>% data.frame(dist = seq(1,500, 10)) %>%
mutate(W = logitKernel(dist, alpha0, alpha1, meanInterDistance, standardDeviationInterDistance)) %>%
ggplot(aes(x=dist, y=W)) + geom_line() + ggplot(aes(x=dist, y=W)) + geom_line() +
labs(x = 'distance between departure and destination basins (km)') labs(x = 'distance between departure and destination basins (km)')
``` ```
```{r} ```{r computeDeathBassinWAA}
# riverAARougier2015 %>% select(basin_name) %>% setdiff(riverBasinsAA %>% select(basin_name)) # compute weight
# distanceAA <- distanceAA %>%
# meanW_AA <- distanceAA %>% inner_join(riverAARougier2015, by =c('departure' = 'basin_name')) %>% mutate(W = logitKernel(distance, alpha0, alpha1, meanInterDistance, standardDeviationInterDistance))
# inner_join(riverAARougier2015, by =c('destination' = 'basin_name')) %>%
# group_by(departure) %>% meanW_AA <- riverBasinsAA %>%
# summarise(sumW = sum(W, na.rm = TRUE), .groups = 'drop') %>% inner_join(distanceAA, by = c("basin_name" = "departure")) %>%
# summarise(mean(sumW)) %>% unlist() %>% unname() group_by(basin_name) %>%
summarise(sumW = sum(W, na.rm = TRUE), .groups = 'drop') %>%
summarise(mean(sumW)) %>% unlist() %>% unname()
meanW_AARouguier2015 <- riverAARougier2015 %>%
inner_join(distanceAARougier2015, by = c("basin_name" = "departure")) %>%
mutate(W = logitKernel(distance, alpha0, alpha1, meanInterDistance, standardDeviationInterDistance)) %>%
group_by(basin_name) %>%
summarise(sumW = sum(W, na.rm = TRUE), .groups = 'drop') %>%
summarise(mean(sumW)) %>% unlist() %>% unname()
WDeathBasinAA = round(meanW_AA * WDeathBasinRougier2005 / meanW_AARouguier2015,2)
``` ```
In Rougier et al. (2015) application, the mean of weight sums is `r round(meanW_AARouguier2015,2)` for a death basin weight of `r round(WDeathBasinRougier2005,2)`. In the present AA application, the mean of weigth sums becomes `r round(meanW_AA,2)`. To keep in concordance with the previous application, the weight of the death basin is now `r round(WDeathBasinAA, 2)`.
```{r computeWeigthAA, echo = TRUE} ```{r computeWeigthAA, echo = TRUE}
# compute weight
distanceAA <- distanceAA %>%
mutate(W = logitKernel(distance, alpha0, alpha1, meanInterDistance, standardDeviationInterDistance))
# add surface area for departure basins # add surface area for departure basins
extendedDistance = distanceAA %>% extendedDistance = distanceAA %>%
inner_join(riverBasinsAA %>% select(basin_name, surface_area_drainage_basin), by=c('departure' = 'basin_name')) %>% inner_join(riverBasinsAA %>%
select(basin_name, surface_area_drainage_basin),
by = c('departure' = 'basin_name')) %>%
rename(surface_departure = surface_area_drainage_basin) rename(surface_departure = surface_area_drainage_basin)
# calculate sum W # calculate sum W
extendedDistance <- extendedDistance %>% extendedDistance <- extendedDistance %>%
inner_join(extendedDistance %>% group_by(departure) %>% summarise(sumW = sum(W, na.rm = TRUE), .groups = "drop"), by=c('departure')) inner_join(extendedDistance %>%
group_by(departure) %>%
summarise(sumW = sum(W, na.rm = TRUE), .groups = "drop"),
by = c('departure'))
# compute strayer mortality and strayer efficiency # compute strayer mortality and strayer efficiency
resultAA <- extendedDistance %>% distinct(departure, sumW) %>% resultAA <- extendedDistance %>% distinct(departure, sumW) %>%
mutate(sm_departure = WDeathBasin / (WDeathBasin + sumW)) %>% mutate(sm_departure = WDeathBasinAA / (WDeathBasinAA + sumW)) %>%
select(departure, sm_departure) %>% select(departure, sm_departure) %>%
rename(basin_name = departure) %>% rename(basin_name = departure) %>%
inner_join( inner_join(
extendedDistance %>% extendedDistance %>%
mutate(p12 = W / (WDeathBasin + sumW), Ap12 = surface_departure * p12) %>% mutate(p12 = W / (WDeathBasinAA + sumW), Ap12 = surface_departure * p12) %>%
group_by(destination) %>% summarise( group_by(destination) %>% summarise(
sumA = sum(surface_departure), sumA = sum(surface_departure),
sumAp12 = sum(Ap12, na.rm = TRUE), sumAp12 = sum(Ap12, na.rm = TRUE),
...@@ -193,46 +200,77 @@ resultAA <- extendedDistance %>% distinct(departure, sumW) %>% ...@@ -193,46 +200,77 @@ resultAA <- extendedDistance %>% distinct(departure, sumW) %>%
inner_join(riverBasinsAA %>% select(basin_name, lat_outlet), by='basin_name') %>% inner_join(riverBasinsAA %>% select(basin_name, lat_outlet), by='basin_name') %>%
rename(latitude = lat_outlet) rename(latitude = lat_outlet)
resultAA #resultAA
``` ```
Strayers from basins at the distribution edge experience a higher mortality rate (Figure \@ref(fig:strayerMortalityAA)) that means if these basins are colonised they will contribute less to settlements in other basins. No trend is detected in the strayer efficiency except at the extreme northern range of the distribution (Figure \@ref(fig:stayerEfficiencyAA)). More or less if all basins are populated, every basin will receive strayers. Nevertheless there is a particular spot around latitude 43°c.
```{r strayerMortalityAA, echo =FALSE, warning = FALSE, include = TRUE, fig.cap="Evolution of the mortality rate according to the latitude of the departure basin in the AA zone"} ```{r strayerMortalityAA, echo =FALSE, warning = FALSE, include = TRUE, 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)) + resultAA %>% ggplot(aes(x = latitude, y = sm_departure)) +
geom_point() + geom_point() +
labs(x = "departure latitude (°)", y = "strayer mortality rate") labs(x = "departure latitude (°)", y = "strayer mortality rate")
#geom_abline(slope = 0, intercept = WDeathBasin / (WDeathBasin + meanW_AA))
``` ```
```{r stayerEfficiencyAA, echo =FALSE, warning = FALSE, include = TRUE, fig.cap="Evolution of the strayers' efficiency according to the latitude of the destination basin in the AA zone"} ```{r stayerEfficiencyAA, echo =FALSE, warning = FALSE, include = TRUE, 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)) + resultAA %>% ggplot(aes(x = latitude, y = se_destination)) +
geom_point() + geom_point() +
labs(x="destination latitude (°)", y = "strayer efficiency") labs(x = "destination latitude (°)", y = "strayer efficiency") +
geom_text(data = filter(resultAA, se_destination > .02), aes(label = basin_name), hjust = 0, nudge_x = 0.05)
``` ```
## North East America NEA application ## North East America NEA application
```{r computeDistanceFeatures}
# meanInterDistance <- mean(distanceNEA$distance, na.rm = TRUE )
# standardDeviationInterDistance <- sd(distanceNEA$distance, na.rm = TRUE)
```
```{r computeWeighthNEA} ```{r computeWeighthNEA}
distanceNEA <- distanceNEA %>% distanceNEA <- distanceNEA %>%
mutate(W = logitKernel(distance, alpha0, alpha1, meanInterDistance, standardDeviationInterDistance)) mutate(W = logitKernel(distance, alpha0, alpha1, meanInterDistance, standardDeviationInterDistance))
distanceNEA %>% group_by(departure) %>%
summarise(min_interdistance = min( distance, na.rm = TRUE), .groups = 'drop') %>%
mutate(pct19 = sum(min_interdistance < 19)/n(),
pct111 = sum(min_interdistance < 111)/n(),
median = median(min_interdistance))
distanceNEA %>% group_by(departure) %>%
summarise(min_interdistance = min( distance, na.rm = TRUE), .groups = 'drop') %>%
inner_join(riverBasinsNEA %>% select(basin_name, lat_outlet), by = c('departure' = 'basin_name')) %>%
arrange(lat_outlet) %>% print(n = Inf)
ggplot(aes(x = lat_outlet, y = min_interdistance )) +geom_point() + geom_abline(intercept = 111, slope = 0)
ecdf1 <- ecdf(distanceNEA %>% group_by(departure) %>%
summarise(min_interdistance = min( distance, na.rm = TRUE), .groups = 'drop') %>% select(min_interdistance) %>% unlist())
plot(ecdf1)
abline(v=c(19, 111))
meanW_NEA <- riverBasinsNEA %>%
inner_join(distanceNEA, by = c("basin_name" = "departure")) %>%
mutate(W = logitKernel(distance, alpha0, alpha1, meanInterDistance, standardDeviationInterDistance)) %>%
group_by(basin_name) %>%
summarise(sumW = sum(W, na.rm = TRUE), .groups = 'drop') %>%
summarise(mean(sumW)) %>% unlist(use.names = FALSE)
WDeathBasinNEA = round(meanW_NEA * WDeathBasinRougier2005 / meanW_AARouguier2015,2)
extendedDistance = distanceNEA %>% extendedDistance = distanceNEA %>%
inner_join(riverBasinsNEA %>% select(basin_name, areasqkm), by=c('departure' = 'basin_name')) %>% inner_join(riverBasinsNEA %>% select(basin_name, areasqkm), by = c('departure' = 'basin_name')) %>%
rename(surface_departure = areasqkm) rename(surface_departure = areasqkm)
extendedDistance <- extendedDistance %>%
extendedDistance <- extendedDistance %>% inner_join(extendedDistance %>% group_by(departure) %>% summarise(sumW = sum(W, na.rm = TRUE), .groups = "drop"), by=c('departure')) inner_join(extendedDistance %>%
group_by(departure) %>%
summarise(sumW = sum(W, na.rm = TRUE), .groups = "drop"),
by = c('departure'))
resultNEA <- extendedDistance %>% distinct(departure, sumW) %>% resultNEA <- extendedDistance %>% distinct(departure, sumW) %>%
mutate(sm_departure = WDeathBasin / (WDeathBasin + sumW)) %>% mutate(sm_departure = WDeathBasinNEA / (WDeathBasinNEA + sumW)) %>%
select(departure, sm_departure) %>% select(departure, sm_departure) %>%
rename(basin_name = departure) %>% rename(basin_name = departure) %>%
inner_join( inner_join(
extendedDistance %>% extendedDistance %>%
mutate(p12 = W / (WDeathBasin + sumW), Ap12 = surface_departure * p12) %>% mutate(p12 = W / (WDeathBasinNEA + sumW), Ap12 = surface_departure * p12) %>%
group_by(destination) %>% summarise( group_by(destination) %>% summarise(
sumA = sum(surface_departure), sumA = sum(surface_departure),
sumAp12 = sum(Ap12, na.rm = TRUE), sumAp12 = sum(Ap12, na.rm = TRUE),
...@@ -243,12 +281,13 @@ resultNEA <- extendedDistance %>% distinct(departure, sumW) %>% ...@@ -243,12 +281,13 @@ resultNEA <- extendedDistance %>% distinct(departure, sumW) %>%
rename(basin_name = destination), rename(basin_name = destination),
by = 'basin_name' by = 'basin_name'
) %>% ) %>%
inner_join(riverBasinsNEA %>% select(basin_name, lat_outlet), by='basin_name') %>% inner_join(riverBasinsNEA %>% select(basin_name, lat_outlet), by ='basin_name') %>%
rename(latitude = lat_outlet) rename(latitude = lat_outlet)
``` ```
```{r strayerMortalityNEA, echo =FALSE, warning = FALSE, include = TRUE, fig.cap="Evolution of strayers mortality according to depature basin latitude in the NEA zone"} The strayer mortality for NEA zone displayed high values for latitudes close to 37° and higher than 42.5 with literally no survival after 50° (Figure \@ref(fig:strayerMortalityNEA). Low values of efficiency are calculated at the range of the distribution (Figure \@ref(fig:strayerEfficiencyLatitudeNEA).
```{r strayerMortalityNEA, echo =FALSE, warning = FALSE, include = TRUE, fig.cap="Evolution of strayers mortality according to departure basin latitude in the NEA zone"}
resultNEA %>% ggplot(aes(x = latitude, y = sm_departure)) + resultNEA %>% ggplot(aes(x = latitude, y = sm_departure)) +
geom_point() + geom_point() +
labs(x = "departure latitude (°)", y = "strayer mortality rate") labs(x = "departure latitude (°)", y = "strayer mortality rate")
...@@ -257,102 +296,155 @@ resultNEA %>% ggplot(aes(x = latitude, y = sm_departure)) + ...@@ -257,102 +296,155 @@ resultNEA %>% ggplot(aes(x = latitude, y = sm_departure)) +
```{r strayerEfficiencyLatitudeNEA, echo =FALSE, warning = FALSE, include = TRUE, fig.cap="Evolution of strayers efficiency according to destination basin latitude in the NEA zone"} ```{r strayerEfficiencyLatitudeNEA, echo =FALSE, warning = FALSE, include = TRUE, fig.cap="Evolution of strayers efficiency according to destination basin latitude in the NEA zone"}
resultNEA %>% ggplot(aes(x = latitude, y = se_destination)) + resultNEA %>% ggplot(aes(x = latitude, y = se_destination)) +
geom_point() + labs(x = "destination latitude (°)", y = "strayer's efficiency") geom_point() + labs(x = "destination latitude (°)", y = "strayer's efficiency")
# geom_text(aes(label = basin_name), hjust = 0, nudge_x = 0.5) # 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 fakeListOfBasin} ```{r fakeListOfBasin}
nbBasin = 150 nbBasin = 150
distBetweenBasin = 10 distBetweenBasin = 10
# create a fake basin tibble # create a fake basin tibble
basin <- tibble(basin_name=paste0('B', formatC(1:nbBasin,width=3, flag = "0"))) %>% mutate(latitude = row_number()) basinFake <- tibble(basin_name=paste0('B', formatC(1:nbBasin,width=3, flag = "0"))) %>% mutate(latitude = row_number())
# create a fake basin-to-basin distance # create a fake basin-to-basin distance
basinDistance <- tibble(departure = basin$basin_name, destination =basin$basin_name) %>% distanceFake <- tibble(departure = basinFake$basin_name, destination = basinFake$basin_name) %>%
expand(departure, destination ) %>% arrange(departure, destination) %>% expand(departure, destination ) %>% arrange(departure, destination) %>%
inner_join(basin, by=c("departure" = "basin_name")) %>% rename(latitude_departure = latitude) %>% inner_join(basinFake, by=c("departure" = "basin_name")) %>% rename(latitude_departure = latitude) %>%
inner_join(basin, by=c("destination" = "basin_name")) %>% rename(latitude_destination = latitude) %>% inner_join(basinFake, by=c("destination" = "basin_name")) %>% rename(latitude_destination = latitude) %>%
mutate(distance = abs(latitude_departure - latitude_destination ) * distBetweenBasin) %>% mutate(distance = abs(latitude_departure - latitude_destination ) * distBetweenBasin) %>%
mutate(W = logitKernel(distance, alpha0, alpha1, meanInterDistance, standardDeviationInterDistance)) mutate(W = logitKernel(distance, alpha0, alpha1, meanInterDistance, standardDeviationInterDistance)) %>%
mutate(distance = replace(distance, departure == destination, NA)) %>%
arrange(departure, destination)
meanW_fake <- basinFake %>%
inner_join(distanceFake, by = c("basin_name" = "departure")) %>%
group_by(basin_name) %>%
summarise(sumW = sum(W, na.rm = TRUE), .groups = 'drop') %>%
summarise(mean(sumW)) %>% unlist(use.names = FALSE)
WDeathBasinFake = round(meanW_fake * WDeathBasinRougier2005 / meanW_AARouguier2015,2)
# compute sumW an p12 # compute sumW an p12
extendedDistance = basinDistance %>% extendedDistance = distanceFake %>%
inner_join(basinDistance %>% group_by(departure ) %>% inner_join(distanceFake %>% 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 + WDeathBasinFake))
``` ```
```{r smFakeUniverse, echo =FALSE, warning = FALSE, include = TRUE, fig.cap = "Evolution of strayer mortality according to latitude departure"} Let a virtual basin with `r nbBasin` basins equally spaced by `r distBetweenBasin`. Figures \@ref(fig:smFake) and \@ref(fig:seFake) present the response in terms of strayers mortality and strayers efficiency.
```{r smFake, echo =FALSE, warning = FALSE, 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 = WDeathBasinFake / (WDeathBasinFake + 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() +
xlim(0,150) + ylim(0.0,.050) labs(x = 'latitude rank', y = 'strayer mortality rate') +
xlim(0,150) + ylim(0.0,.15)
``` ```
```{r seFakeUniverse, echo =FALSE, warning = FALSE, include = TRUE, fig.cap="Evolution of strayer efficiency according to departure latitude " } ```{r seFake, echo =FALSE, warning = FALSE, include = TRUE, fig.cap="Evolution of strayer efficiency according to departure latitude " }
extendedDistance %>% extendedDistance %>%
group_by(destination, latitude_destination) %>% 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)) + ggplot(aes(x=latitude_destination, y = se_destination)) +
geom_point() + labs(x = 'latitude rank', y = 'strayer efficiency') + geom_point() + labs(x = 'latitude rank', y = 'strayer efficiency') +
xlim(0,150) + ylim(0.0,.010) xlim(0,150) + ylim(0.0,.05)
``` ```
### 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) basinSampling <- basinFake %>% sample_n(25) %>% arrange(latitude)
distanceSampling <- distanceFake %>%
inner_join(basinSampling %>% select(basin_name), by = c("departure" = "basin_name")) %>%
inner_join(basinSampling %>% select(basin_name), by = c("destination" = "basin_name"))
sampledBasinDistance <- basinDistance %>% inner_join(sampledBasin %>% select(basin_name), by = c("departure" = "basin_name")) %>%
inner_join(sampledBasin %>% select(basin_name), by = c("destination" = "basin_name"))
# compute sumW an p12 # compute sumW an p12
extendedSampledDistance = sampledBasinDistance %>% extendedDistanceSampling = distanceSampling %>%
inner_join(sampledBasinDistance %>% group_by(departure ) %>% inner_join(distanceSampling %>% group_by(departure ) %>%
summarise(sumW = sum(W, na.rm = TRUE), .groups = 'drop'), by='departure') %>% summarise(sumW = sum(W, na.rm = TRUE), .groups = 'drop'),
mutate(p12 = W / (sumW + WDeathBasin)) by ='departure')
meanW_sampling <- basinSampling %>%
inner_join(distanceSampling, by = c("basin_name" = "departure")) %>%
group_by(basin_name) %>%
summarise(sumW = sum(W, na.rm = TRUE), .groups = 'drop') %>%
summarise(mean(sumW)) %>%
unlist(use.names = FALSE)
WDeathBasinSampling = round(meanW_sampling * WDeathBasinRougier2005 / meanW_AARouguier2015,2)
extendedDistanceSampling <- extendedDistanceSampling %>%
mutate(p12 = W / (sumW + WDeathBasinSampling))
``` ```
```{r smSampledUniverse, echo =FALSE, warning = FALSE, include = TRUE, fig.cap="Evolution of strayer mortality according to latitude departure" } Now we only consider a random sampling of `r nrow(basinSampling)` basins. The consequences of this sampling are presented in figures \@ref(fig :smSampled) and \@ref(fig:seSampled).
extendedSampledDistance %>% distinct(departure, latitude_departure, sumW) %>%
mutate(sm_departure = WDeathBasin /(WDeathBasin + sumW)) %>% ```{r smSampled, echo =FALSE, warning = FALSE, include = TRUE, fig.cap="Evolution of strayer mortality according to latitude departure" }
extendedDistanceSampling %>% distinct(departure, latitude_departure, sumW) %>%
mutate(sm_departure = WDeathBasinSampling /(WDeathBasinSampling + 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, echo =FALSE, warning = FALSE, include = TRUE, fig.cap="Evolution of strayer efficiency according to latitude departure" } ```{r seSampled, echo =FALSE, warning = FALSE, include = TRUE, fig.cap="Evolution of strayer efficiency according to departure latitude with HaDiad kernel function"}
extendedSampledDistance %>% group_by(destination, latitude_destination) %>% extendedDistanceSampling %>% 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 \#Comparison with HyDiaD formulation
In HyDiad the kernel function in an extended negative exponential of the distance between basins. Mortality of strayers is simulated with a mortality coefficient according to inter-basin distances (\@ref(fig:smFunctionHaDiaD). Resulting strayer mortality pattern is presented in \@ref(fig : smHaDiaD).
```{r HaDiaD, echo =FALSE, warning = FALSE, include = TRUE} ```{r smFunctionHaDiaD, echo =FALSE, warning = FALSE, include = TRUE, fig.cap="Evolution of mortality efficiency according to departure latitude with HaDiad kernel function"}
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
HADiaD <- basinDistance %>% mutate(W = eneKernel(distance, alpha_D, beta_D), strayerMortalityRate = 1- strayerSurvival(distance, m) )
tibble(distance = 0:500) %>% mutate(strayerMortalityRate = 1- strayerSurvival(distance, m)) %>% tibble(distance = 0:500) %>% mutate(strayerMortalityRate = 1- strayerSurvival(distance, m)) %>%
ggplot(aes(x= distance, y =strayerMortalityRate)) + geom_point() ggplot(aes(x = distance, y = strayerMortalityRate)) + geom_line()
```
```{r smHaDiaD, echo =FALSE, warning = FALSE, include = TRUE, fig.cap="Evolution of mortality efficiency according to departure latitude with HaDiad kernel function"}
HADiaD <- distanceFake %>%
mutate(W = eneKernel(distance, alpha_D, beta_D),
p12 = W/ sum(W, na.rm = TRUE),
strayerMortalityRate = 1 - strayerSurvival(distance, m))
HADiaD %>% group_by(departure, latitude_departure) %>% HADiaD %>% group_by(departure, latitude_departure) %>%
summarise(sumW=sum(W), sm_depature = weighted.mean(strayerMortalityRate, W) ) %>% summarise(sm_departure = weighted.mean(strayerMortalityRate, W, na.rm = TRUE), .groups = 'drop' ) %>%
ggplot(aes(x = latitude_departure, y =sm_depature)) + geom_point() ggplot(aes(x = latitude_departure, y =sm_departure)) + geom_point()
```
```{r seHaDiaDHaDiaD, echo =FALSE, warning = FALSE, include = TRUE}
# HADiaD %>% group_by(destination, latitude_destination) %>%
# summarise(se_destination = weighted.mean(strayerMortalityRate, W, , na.rm = TRUE), .groups = 'drop') %>%
# ggplot(aes(x = latitude_destination, y = se_destination)) + geom_point()
#
``` ```
# Conclusion # Conclusion
The strayer mortality increases at the edge of the distribution. The strayer mortality increases at the edge of the distribution.
The selection of basins impacts the strayers mortality. It is probably safer to considered a constant rate rather a death basin. It is a priority to improve the coverage of the area by increasing the number of basins considered. The selection of basins impacts the strayers mortality. It is probably safer to consider a constant rate rather a death basin. It is a priority to improve the coverage of the area by increasing the number of basins considered.
The logit function to compute the basin weights introduces a plateau for the short distance that leads to a random destination in the departure vicinity.
**Steps to calibrate online the process**
- determine the kernel function (to fit the median and maximum distances for strayers);
- calculate the destination basins weights for each departure basin;
- calculate the sum of destination basins weights for each departure basin;
The logit function to compute the basin weights introduces a plateau for the short distance that leads to random destination in the the departure vicinity - fix the death basin weight to the mean of these sums.
# References # References
exploration/GR3D_Rdescription/deathBasinW.docx
+ 0
− 0
View file @ 458ef3c4
No preview for this file type
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