deathBasinW.Rmd 21 KB
Newer Older
1
2
3
4
---
title: "Weight for the death basin for the North-East America application of GR3D"
author: "P. Lambert"
date: "`r format(Sys.time(), '%d %B %Y')`"
5
bibliography: biblio.bib
6
7
csl: ecological-modelling.csl
output:
patrick.lambert's avatar
patrick.lambert committed
8
  bookdown::word_document2:
9
    df_print: kable
patrick.lambert's avatar
patrick.lambert committed
10
11
12
13
14
15
16
17
18
19
    reference_docx: ref_doc.dotx
#    toc: yes
 #   fig_caption: yes
    plots:
      style: Normal
      align: center
      caption:
        style: Image Caption
        pre: 'Figure '
        sep: ': '
20
#    do: default
21
22
editor_options: 
  chunk_output_type: console
23
24
25
---

```{r setup, include=FALSE}
patrick.lambert's avatar
patrick.lambert committed
26
knitr::opts_chunk$set(echo = TRUE, include = FALSE,  fig.alig = 'left')
27
28
```

29
```{r library}
30
31
32
33
34
library(dplyr)
library(tidyr)
library(ggplot2)
library(knitr)
library(flextable)
patrick.lambert's avatar
patrick.lambert committed
35
36
library(bookdown)
library(stringr)
patrick.lambert's avatar
patrick.lambert committed
37
38
39
library(purrr)


40
41
```

42
43
44
45
46
47
```{r load data}
rm(list = ls())

# load list of basins  and distance matrix (with "_" instead of " " and "." in basin name)
distanceAA <-  as.matrix(read.csv("../../data/input/atlanticarea/distanceGridAA.csv", row.names = 1, stringsAsFactors = FALSE))
distanceAA <- distanceAA %>%
48
  replace(., col(.) == row(.), NA) %>% 
49
50
51
52
53
54
55
56
57
58
59
60
61
  as.data.frame() %>% mutate(destination = str_replace_all(row.names(.), "([ '\\-\\.])", "_")) %>% 
  pivot_longer(cols = -destination, names_to = 'departure', values_to = 'distance') %>%
  mutate(departure = str_replace_all(departure, "([ '\\-\\.])", "_")) %>% 
  dplyr::select(departure, destination, distance) %>% 
  arrange(departure, distance)

riverBasinsAA =  read.csv("../../data/input/atlanticarea/aa_basins.csv") %>% 
  mutate(basin_name = str_replace_all(basin_name, "([ '\\-\\.])", "_"))

distanceNEA <-  as.matrix(read.csv("../../data/input/northeastamerica/distanceGridNEA.csv", row.names = 1, stringsAsFactors = FALSE))
distanceNEA <- distanceNEA %>%
  replace(., col(.) == row(.), NA) %>% 
  as.data.frame() %>% mutate(destination = str_replace_all(row.names(.), "([ '\\-\\.])", "_")) %>% 
62
  pivot_longer(cols = -destination, names_to = 'departure', values_to = 'distance') %>% 
patrick.lambert's avatar
patrick.lambert committed
63
  mutate(departure = str_replace_all(departure, "([ '\\-\\.])", "_")) %>% 
64
65
66
  dplyr::select(departure, destination, distance) %>% 
  arrange(departure, distance)

67
68
69
70
71
72
73
74
riverBasinsNEA =  read.csv("../../data/input/northeastamerica/nea_riverbasins.csv") %>% 
  mutate(basin_name = str_replace_all(basin_name, "([ '\\-\\.])", "_")) 

# nameRiver = riverBasinsNEA %>%  select(basin_name) %>% arrange(basin_name)
# nameDistance = distanceNEA %>% distinct(departure) %>% rename(basin_name = departure) %>% arrange(basin_name)
#  nameRiver %>% setdiff(nameDistance)
# nameDistance %>% setdiff(nameRiver)

patrick.lambert's avatar
patrick.lambert committed
75
76
77
78
79
80
81
82
83
84
# 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)
85
86
87

```

88
```{r load GR3D function}
89
90
91
92
source("GR3Dfunction.R")

```

93
94
95
96
# Computation of the death basin weight

## Baseline

patrick.lambert's avatar
patrick.lambert committed
97
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.
98
99
100
101
102
103

The first step is to compute for a departure $j_1$ the weight of each destination basin $j_2$ using:

$$w_{j_1\rightarrow j_2} = \frac {1} {1 +  e ^{\alpha_0 + \alpha_1 \cdot {\frac {( D_{j_1\rightarrow j_2}   - \mu_D)} {\sigma_D} } } }$$

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.
104

patrick.lambert's avatar
patrick.lambert committed
105
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.
106
107
108

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}}$$

patrick.lambert's avatar
patrick.lambert committed
109
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
110
111
112

$$
p_{j_1 \rightarrow j_2} =  \frac {w_{j_1 \rightarrow j_2}} {w_{death} + w_{j_1}} 
patrick.lambert's avatar
patrick.lambert committed
113
$$ \#\# 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:
114
115
116

$$ sm_{ j_1} = \frac {w_{death}} { w_{death}+w_{j_1} }$$

117
The efficiency for strayers $se_{j2}$ informs on the proportion of fish that are able to reach a destination basin considering abundance in departure basins proportional to surface area of these basins. It is computed with:
118
119
120
121
122
123
124

$$
se_{j_2} = \frac {\sum_{j_1}{A_{j_1} \cdot  p_{j_1 \rightarrow j_2} }} {\sum_{j_1} {A_{j_1}}}
$$

## Atlantic area application

125
126
127
128
129
```{r}
alpha0 = -2.9
alpha1 =  19.7
meanInterDistance = 300
standardDeviationInterDistance = 978
patrick.lambert's avatar
patrick.lambert committed
130
WDeathBasinRougier2005 = .4
131
```
132

patrick.lambert's avatar
patrick.lambert committed
133
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`.
134

patrick.lambert's avatar
patrick.lambert committed
135
136
137
```{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)) %>% 
patrick.lambert's avatar
patrick.lambert committed
138
  ggplot(aes(x=dist, y=W)) + geom_line() + 
patrick.lambert's avatar
patrick.lambert committed
139
  labs(x = 'distance between departure and destination basins (km)')
140
141
```

patrick.lambert's avatar
patrick.lambert committed
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
```{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)
161
162
163

```

patrick.lambert's avatar
patrick.lambert committed
164
165
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)`.

166
167
168
169
```{r computeWeigthAA, echo = TRUE}

# add surface area for departure basins
extendedDistance  = distanceAA %>% 
patrick.lambert's avatar
patrick.lambert committed
170
171
172
  inner_join(riverBasinsAA %>% 
               select(basin_name, surface_area_drainage_basin), 
             by = c('departure' = 'basin_name')) %>% 
173
174
175
176
  rename(surface_departure = surface_area_drainage_basin)

# calculate sum W
extendedDistance <- extendedDistance %>% 
patrick.lambert's avatar
patrick.lambert committed
177
178
179
180
  inner_join(extendedDistance %>% 
               group_by(departure) %>% 
               summarise(sumW = sum(W, na.rm = TRUE), .groups = "drop"), 
             by = c('departure'))
181
182
183

# compute strayer mortality and strayer efficiency
resultAA  <- extendedDistance %>% distinct(departure, sumW) %>%
patrick.lambert's avatar
patrick.lambert committed
184
  mutate(sm_departure = WDeathBasinAA / (WDeathBasinAA + sumW)) %>%
185
186
187
188
  select(departure, sm_departure) %>%
  rename(basin_name = departure) %>%
  inner_join(
    extendedDistance %>%
patrick.lambert's avatar
patrick.lambert committed
189
      mutate(p12 = W / (WDeathBasinAA + sumW), Ap12 = surface_departure * p12) %>%
190
191
192
193
194
195
196
197
198
199
200
201
202
      group_by(destination) %>% summarise(
        sumA = sum(surface_departure),
        sumAp12 = sum(Ap12, na.rm = TRUE),
        .groups = 'drop'
      ) %>%
      mutate(se_destination = sumAp12 / sumA) %>%
      select (destination, se_destination) %>%
      rename(basin_name = destination),
    by = 'basin_name'
  ) %>% 
  inner_join(riverBasinsAA %>% select(basin_name, lat_outlet), by='basin_name') %>% 
  rename(latitude = lat_outlet)

patrick.lambert's avatar
patrick.lambert committed
203
#resultAA 
204
```
205

patrick.lambert's avatar
patrick.lambert committed
206
207
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.

208
```{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"}
patrick.lambert's avatar
patrick.lambert committed
209
210
resultAA %>% ggplot(aes(x = latitude, y = sm_departure)) +
  geom_point() + 
patrick.lambert's avatar
patrick.lambert committed
211
212
213
  labs(x = "departure latitude (°)", y = "strayer mortality rate") 
  #geom_abline(slope = 0, intercept = WDeathBasin / (WDeathBasin + meanW_AA))

214
215
```

216
217
218
```{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() + 
patrick.lambert's avatar
patrick.lambert committed
219
220
  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)
221
```
222

patrick.lambert's avatar
patrick.lambert committed
223
## North East America NEA application
224

225
226
227
228
```{r computeWeighthNEA}
distanceNEA <- distanceNEA %>% 
  mutate(W =  logitKernel(distance, alpha0, alpha1, meanInterDistance, standardDeviationInterDistance))

patrick.lambert's avatar
patrick.lambert committed
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
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)

257
extendedDistance  = distanceNEA %>% 
patrick.lambert's avatar
patrick.lambert committed
258
  inner_join(riverBasinsNEA %>% select(basin_name, areasqkm), by = c('departure' = 'basin_name')) %>% 
259
260
  rename(surface_departure = areasqkm)

patrick.lambert's avatar
patrick.lambert committed
261
262
263
264
265
extendedDistance <- extendedDistance %>% 
  inner_join(extendedDistance %>% 
               group_by(departure) %>% 
               summarise(sumW = sum(W, na.rm = TRUE), .groups = "drop"), 
             by = c('departure'))
266
267

resultNEA  <- extendedDistance %>% distinct(departure, sumW) %>%
patrick.lambert's avatar
patrick.lambert committed
268
  mutate(sm_departure = WDeathBasinNEA / (WDeathBasinNEA + sumW)) %>%
269
270
271
272
  select(departure, sm_departure) %>%
  rename(basin_name = departure) %>%
  inner_join(
    extendedDistance %>%
patrick.lambert's avatar
patrick.lambert committed
273
      mutate(p12 = W / (WDeathBasinNEA + sumW), Ap12 = surface_departure * p12) %>%
274
275
276
277
278
279
280
281
282
283
      group_by(destination) %>% summarise(
        sumA = sum(surface_departure),
        sumAp12 = sum(Ap12, na.rm = TRUE),
        .groups = 'drop'
      ) %>%
      mutate(se_destination = sumAp12 / sumA) %>%
      select (destination, se_destination) %>%
      rename(basin_name = destination),
    by = 'basin_name'
  ) %>% 
patrick.lambert's avatar
patrick.lambert committed
284
  inner_join(riverBasinsNEA %>% select(basin_name, lat_outlet), by ='basin_name') %>% 
285
  rename(latitude = lat_outlet)
286
```
patrick.lambert's avatar
patrick.lambert committed
287

patrick.lambert's avatar
patrick.lambert committed
288
289
290
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"}
patrick.lambert's avatar
patrick.lambert committed
291
resultNEA %>% ggplot(aes(x = latitude, y = sm_departure)) + 
292
293
  geom_point() + 
  labs(x = "departure latitude (°)", y = "strayer mortality rate")
294
295
```

296
```{r strayerEfficiencyLatitudeNEA, echo =FALSE, warning = FALSE, include = TRUE, fig.cap="Evolution of strayers efficiency according to destination basin latitude in the NEA zone"}
patrick.lambert's avatar
patrick.lambert committed
297
298
resultNEA %>% ggplot(aes(x = latitude, y = se_destination)) + 
  geom_point() + labs(x = "destination latitude (°)", y = "strayer's efficiency") 
patrick.lambert's avatar
patrick.lambert committed
299
# geom_text(aes(label = basin_name),  hjust = 0, nudge_x = 0.5)
patrick.lambert's avatar
patrick.lambert committed
300
```
301

302
## Virtual linear network of basin
303

patrick.lambert's avatar
patrick.lambert committed
304
### Full universe
305

patrick.lambert's avatar
patrick.lambert committed
306
```{r fakeListOfBasin}
307
nbBasin = 150
308
309
distBetweenBasin = 10
# create a fake basin tibble
patrick.lambert's avatar
patrick.lambert committed
310
basinFake <- tibble(basin_name=paste0('B', formatC(1:nbBasin,width=3, flag = "0"))) %>% mutate(latitude = row_number())
311
312

# create a fake basin-to-basin distance
patrick.lambert's avatar
patrick.lambert committed
313
distanceFake <- tibble(departure = basinFake$basin_name, destination = basinFake$basin_name) %>% 
314
  expand(departure, destination ) %>% arrange(departure, destination) %>% 
patrick.lambert's avatar
patrick.lambert committed
315
316
  inner_join(basinFake, by=c("departure" = "basin_name"))  %>% rename(latitude_departure = latitude) %>% 
  inner_join(basinFake, by=c("destination" = "basin_name"))  %>% rename(latitude_destination = latitude) %>% 
317
  mutate(distance = abs(latitude_departure - latitude_destination ) * distBetweenBasin) %>% 
patrick.lambert's avatar
patrick.lambert committed
318
319
320
  mutate(W =  logitKernel(distance, alpha0, alpha1, meanInterDistance, standardDeviationInterDistance)) %>%   
  mutate(distance = replace(distance, departure == destination, NA)) %>% 
  arrange(departure, destination)
321

patrick.lambert's avatar
patrick.lambert committed
322
323
324
325
326
327
328
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)
329
# compute sumW an p12
patrick.lambert's avatar
patrick.lambert committed
330
331
extendedDistance = distanceFake %>% 
  inner_join(distanceFake %>% group_by(departure ) %>% 
patrick.lambert's avatar
patrick.lambert committed
332
               summarise(sumW = sum(W, na.rm = TRUE), .groups = 'drop'), by='departure') %>% 
patrick.lambert's avatar
patrick.lambert committed
333
  mutate(p12 = W/(sumW + WDeathBasinFake))
334
```
patrick.lambert's avatar
patrick.lambert committed
335

patrick.lambert's avatar
patrick.lambert committed
336
337
338
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"}
339
extendedDistance %>% distinct(departure, latitude_departure, sumW) %>% 
patrick.lambert's avatar
patrick.lambert committed
340
341
342
343
 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)
344
345
```

patrick.lambert's avatar
patrick.lambert committed
346
```{r seFake, echo =FALSE, warning = FALSE, include = TRUE,  fig.cap="Evolution of strayer efficiency according to departure latitude " }
patrick.lambert's avatar
patrick.lambert committed
347
348
349
350
extendedDistance %>% 
  group_by(destination, latitude_destination) %>% 
  summarise(se_destination = mean(p12), .groups ='drop') %>% 
  ggplot(aes(x=latitude_destination, y = se_destination)) +
patrick.lambert's avatar
patrick.lambert committed
351
352
  geom_point() + labs(x = 'latitude rank', y = 'strayer efficiency') +
  xlim(0,150) + ylim(0.0,.05)
353
354
```

patrick.lambert's avatar
patrick.lambert committed
355
### Sampled universe
356

357
```{r  irregular sampling of fake universe, echo FALSE}
patrick.lambert's avatar
patrick.lambert committed
358
359
360
361
362
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")) 
363
364


365
# compute sumW an p12
patrick.lambert's avatar
patrick.lambert committed
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
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))
382
```
patrick.lambert's avatar
patrick.lambert committed
383

patrick.lambert's avatar
patrick.lambert committed
384
385
386
387
388
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)) %>% 
389
  ggplot(aes(x=latitude_departure, y = sm_departure)) + geom_point() + labs(x='latitude rank', y = 'strayer mortality rate') +
patrick.lambert's avatar
patrick.lambert committed
390
  xlim(0,150) + ylim(0.0,.2)
391
```
392

patrick.lambert's avatar
patrick.lambert committed
393
394
```{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) %>% 
395
  summarise(se_destination = mean(p12), .groups ='drop') %>% 
patrick.lambert's avatar
patrick.lambert committed
396
  ggplot(aes(x = latitude_destination, y = se_destination)) + geom_point() + labs(x = 'latitude rank', y = 'strayer efficiency') +
patrick.lambert's avatar
patrick.lambert committed
397
  xlim(0,150) + ylim(0.0,0.1)
398
```
399

patrick.lambert's avatar
patrick.lambert committed
400
401
402
\#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).
patrick.lambert's avatar
patrick.lambert committed
403

patrick.lambert's avatar
patrick.lambert committed
404
```{r smFunctionHaDiaD, echo =FALSE, warning = FALSE, include = TRUE,  fig.cap="Evolution of mortality efficiency according to departure latitude with HaDiad kernel function"}
405
406
407
alpha_D = 0.0608
beta_D = 0.655
m = -log(0.464)/41
408

409
tibble(distance = 0:500) %>% mutate(strayerMortalityRate = 1- strayerSurvival(distance, m)) %>% 
patrick.lambert's avatar
patrick.lambert committed
410
411
412
413
414
415
416
417
  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))
418
419

HADiaD %>%   group_by(departure, latitude_departure) %>%
patrick.lambert's avatar
patrick.lambert committed
420
421
422
423
  summarise(sm_departure = weighted.mean(strayerMortalityRate, W, na.rm = TRUE), .groups = 'drop' ) %>% 
  ggplot(aes(x = latitude_departure, y =sm_departure)) + geom_point()

```
424

patrick.lambert's avatar
patrick.lambert committed
425
426
427
428
429
```{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() 
# 
430
```
431
432
433
434
435

# Conclusion

The strayer mortality increases at the edge of the distribution.

patrick.lambert's avatar
patrick.lambert committed
436
437
438
439
440
441
442
443
444
445
446
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;
447

patrick.lambert's avatar
patrick.lambert committed
448
-   fix the death basin weight to the mean of these sums.
449
450

# References