diff --git a/exploration/GR3D_Rdescription/deathBasinW.Rmd b/exploration/GR3D_Rdescription/deathBasinW.Rmd index be4bf10829448cf2025070e96358adc7a749d57c..e28f24d5e410d11c8849294f0ae89c51a9e2d064 100644 --- a/exploration/GR3D_Rdescription/deathBasinW.Rmd +++ b/exploration/GR3D_Rdescription/deathBasinW.Rmd @@ -34,6 +34,9 @@ library(knitr) library(flextable) library(bookdown) library(stringr) +library(purrr) + + ``` ```{r load data} @@ -69,9 +72,16 @@ riverBasinsNEA = read.csv("../../data/input/northeastamerica/nea_riverbasins.cs # nameRiver %>% setdiff(nameDistance) # nameDistance %>% setdiff(nameRiver) -# riverAARougier2015 = read.csv("basinsRougieretal2015.csv", stringsAsFactors = FALSE) %>% -# rename(basin_id = id, basin_name = nomBV) %>% -# mutate(basin_name =replace(basin_name, basin_name == "Sevre_Niortaise", "Sevre Niortaise")) +# Rougier at al 2015 application +riverAARougier2015 = read.csv("basinsRougieretal2015.csv", stringsAsFactors = FALSE) %>% + 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") ## 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: @@ -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. -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}}$$ -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}} -$$ -## 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: +$$ \#\# 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: $$ sm_{ j_1} = \frac {w_{death}} { w_{death}+w_{j_1} }$$ @@ -114,72 +122,71 @@ $$ ## 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} alpha0 = -2.9 alpha1 = 19.7 meanInterDistance = 300 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`. - -```{r} -dist = seq(1,500, 10) -dataKernel = data.frame(dist = dist, W = logitKernel(dist, alpha0, alpha1, meanInterDistance, standardDeviationInterDistance)) -``` +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 drawKernelFunctionAA, echo =FALSE, warning = FALSE, include = TRUE, fig.cap = "Kernel function for AA application"} -dataKernel %>% +```{r drawKernelFunctionAA, echo = FALSE, warning = FALSE, include = TRUE, fig.cap = "Kernel function for AA application"} +data.frame(dist = seq(1,500, 10)) %>% + mutate(W = logitKernel(dist, alpha0, alpha1, meanInterDistance, standardDeviationInterDistance)) %>% 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} -# riverAARougier2015 %>% select(basin_name) %>% setdiff(riverBasinsAA %>% select(basin_name)) -# -# meanW_AA <- distanceAA %>% inner_join(riverAARougier2015, by =c('departure' = 'basin_name')) %>% -# inner_join(riverAARougier2015, by =c('destination' = 'basin_name')) %>% -# group_by(departure) %>% -# summarise(sumW = sum(W, na.rm = TRUE), .groups = 'drop') %>% -# summarise(mean(sumW)) %>% unlist() %>% unname() +```{r computeDeathBassinWAA} +# compute weight +distanceAA <- distanceAA %>% + mutate(W = logitKernel(distance, alpha0, alpha1, meanInterDistance, standardDeviationInterDistance)) + +meanW_AA <- riverBasinsAA %>% + inner_join(distanceAA, by = c("basin_name" = "departure")) %>% + 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} -# compute weight -distanceAA <- distanceAA %>% - mutate(W = logitKernel(distance, alpha0, alpha1, meanInterDistance, standardDeviationInterDistance)) # add surface area for departure basins 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) # calculate sum W 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 resultAA <- extendedDistance %>% distinct(departure, sumW) %>% - mutate(sm_departure = WDeathBasin / (WDeathBasin + sumW)) %>% + mutate(sm_departure = WDeathBasinAA / (WDeathBasinAA + sumW)) %>% select(departure, sm_departure) %>% rename(basin_name = departure) %>% inner_join( extendedDistance %>% - mutate(p12 = W / (WDeathBasin + sumW), Ap12 = surface_departure * p12) %>% + mutate(p12 = W / (WDeathBasinAA + sumW), Ap12 = surface_departure * p12) %>% group_by(destination) %>% summarise( sumA = sum(surface_departure), sumAp12 = sum(Ap12, na.rm = TRUE), @@ -193,46 +200,77 @@ resultAA <- extendedDistance %>% distinct(departure, sumW) %>% inner_join(riverBasinsAA %>% select(basin_name, lat_outlet), by='basin_name') %>% 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"} resultAA %>% ggplot(aes(x = latitude, y = sm_departure)) + 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"} resultAA %>% ggplot(aes(x = latitude, y = se_destination)) + 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 -```{r computeDistanceFeatures} -# meanInterDistance <- mean(distanceNEA$distance, na.rm = TRUE ) -# standardDeviationInterDistance <- sd(distanceNEA$distance, na.rm = TRUE) -``` - ```{r computeWeighthNEA} distanceNEA <- distanceNEA %>% 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 %>% - 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) - -extendedDistance <- extendedDistance %>% inner_join(extendedDistance %>% group_by(departure) %>% summarise(sumW = sum(W, na.rm = TRUE), .groups = "drop"), by=c('departure')) +extendedDistance <- extendedDistance %>% + inner_join(extendedDistance %>% + group_by(departure) %>% + summarise(sumW = sum(W, na.rm = TRUE), .groups = "drop"), + by = c('departure')) resultNEA <- extendedDistance %>% distinct(departure, sumW) %>% - mutate(sm_departure = WDeathBasin / (WDeathBasin + sumW)) %>% + mutate(sm_departure = WDeathBasinNEA / (WDeathBasinNEA + sumW)) %>% select(departure, sm_departure) %>% rename(basin_name = departure) %>% inner_join( extendedDistance %>% - mutate(p12 = W / (WDeathBasin + sumW), Ap12 = surface_departure * p12) %>% + mutate(p12 = W / (WDeathBasinNEA + sumW), Ap12 = surface_departure * p12) %>% group_by(destination) %>% summarise( sumA = sum(surface_departure), sumAp12 = sum(Ap12, na.rm = TRUE), @@ -243,12 +281,13 @@ resultNEA <- extendedDistance %>% distinct(departure, sumW) %>% rename(basin_name = destination), 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) - ``` -```{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)) + geom_point() + labs(x = "departure latitude (°)", y = "strayer mortality rate") @@ -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"} 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) +# geom_text(aes(label = basin_name), hjust = 0, nudge_x = 0.5) ``` ## Virtual linear network of basin -### full universe +### Full universe ```{r fakeListOfBasin} nbBasin = 150 distBetweenBasin = 10 # 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 -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) %>% - inner_join(basin, 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("departure" = "basin_name")) %>% rename(latitude_departure = latitude) %>% + inner_join(basinFake, by=c("destination" = "basin_name")) %>% rename(latitude_destination = latitude) %>% 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 -extendedDistance = basinDistance %>% - inner_join(basinDistance %>% group_by(departure ) %>% +extendedDistance = distanceFake %>% + inner_join(distanceFake %>% group_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) %>% - mutate(sm_departure = WDeathBasin /(WDeathBasin + sumW)) %>% - 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) + mutate(sm_departure = WDeathBasinFake / (WDeathBasinFake + sumW)) %>% + ggplot(aes(x=latitude_departure, y = sm_departure)) + geom_point() + + 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 %>% 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) + geom_point() + labs(x = 'latitude rank', y = 'strayer efficiency') + + xlim(0,150) + ylim(0.0,.05) ``` ### Sampled universe ```{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 -extendedSampledDistance = sampledBasinDistance %>% - inner_join(sampledBasinDistance %>% group_by(departure ) %>% - summarise(sumW = sum(W, na.rm = TRUE), .groups = 'drop'), by='departure') %>% - mutate(p12 = W / (sumW + WDeathBasin)) +extendedDistanceSampling = distanceSampling %>% + inner_join(distanceSampling %>% group_by(departure ) %>% + summarise(sumW = sum(W, na.rm = TRUE), .groups = 'drop'), + 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" } -extendedSampledDistance %>% distinct(departure, latitude_departure, sumW) %>% - mutate(sm_departure = WDeathBasin /(WDeathBasin + sumW)) %>% +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). + +```{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') + 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" } -extendedSampledDistance %>% group_by(destination, latitude_destination) %>% +```{r seSampled, echo =FALSE, warning = FALSE, include = TRUE, fig.cap="Evolution of strayer efficiency according to departure latitude with HaDiad kernel function"} +extendedDistanceSampling %>% 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') + + 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) ``` -# 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 beta_D = 0.655 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)) %>% - 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) %>% - summarise(sumW=sum(W), sm_depature = weighted.mean(strayerMortalityRate, W) ) %>% - ggplot(aes(x = latitude_departure, y =sm_depature)) + geom_point() + summarise(sm_departure = weighted.mean(strayerMortalityRate, W, na.rm = TRUE), .groups = 'drop' ) %>% + 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 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 diff --git a/exploration/GR3D_Rdescription/deathBasinW.docx b/exploration/GR3D_Rdescription/deathBasinW.docx index 8705a0f4a96637d3ae8f3b1c198cba3b290ef0d3..90627edb1c4aed4f2a5a028df4357692e0980c9a 100644 Binary files a/exploration/GR3D_Rdescription/deathBasinW.docx and b/exploration/GR3D_Rdescription/deathBasinW.docx differ