Skip to content

Commit

Permalink
Upddate vignette results.
Browse files Browse the repository at this point in the history
  • Loading branch information
@darrennorris
darrennorris committed Jul 22, 2024
1 parent 497ece6 commit 01e9f61
Show file tree
Hide file tree
Showing 7 changed files with 145 additions and 64 deletions.
5 changes: 4 additions & 1 deletion DESCRIPTION
View file
Original file line number Diff line number Diff line change
Expand Up @@ -15,7 +15,10 @@ Suggests:
leaflet,
leafem,
htmltools,
dplyr,
dplyr,
ggplot2,
patchwork,
Hmisc,
rmarkdown
VignetteBuilder: knitr
Depends:
Expand Down
21 changes: 13 additions & 8 deletions README.Rmd
View file
Original file line number Diff line number Diff line change
Expand Up @@ -56,7 +56,7 @@ remotes::install_github("darrennorris/testmap")

This is a basic example which shows a summary of
where *Podocnemis unifilis* is Endangered.
An example with code to make a map is here:
Another example with code to make a map is here:
https://darrennorris.github.io/testmap/articles/testmap.html

```{r example, warning=FALSE, message=FALSE}
Expand All @@ -67,14 +67,19 @@ library(dplyr)
points_bau_ffr |>
dplyr::mutate(flag_EN = if_else(fem_diff_t42 <= -0.5, 1, 0)) |>
dplyr::group_by(COUNTRY) |>
dplyr::summarise(length_river = n(),
dplyr::summarise(pop_start = sum(fem_t0),
pop_end = sum(fem_t42),
pop_change = round(((sum(fem_t42) - sum(fem_t0)) / sum(fem_t0)), 3),
change_lcl_95 = Hmisc::smean.cl.boot(fem_diff_t42)["Lower"],
change_ucl_95 = Hmisc::smean.cl.boot(fem_diff_t42)["Upper"],
length_river = n(),
length_endangered = sum((flag_EN))) |>
ungroup() |>
mutate(proportion_endangered = round((length_endangered / length_river), 2)) |>
mutate(threat_status = case_when(proportion_endangered >= 0.8 ~ "Critically Endangered",
proportion_endangered >= 0.5 ~ "Endangered",
proportion_endangered >= 0.3 ~ "Vulnerable",
proportion_endangered >= 0.2 ~ "Near Threatened"))
dplyr::ungroup() |>
dplyr::mutate(proportion_endangered = round((length_endangered / length_river), 2)) |>
dplyr::mutate(threat_status = case_when(pop_change <= -0.8 ~ "Critically Endangered",
pop_change <= -0.5 ~ "Endangered",
pop_change <= -0.3 ~ "Vulnerable",
pop_change <= -0.2 ~ "Near Threatened"))
```


Expand Down
47 changes: 27 additions & 20 deletions README.md
View file
Original file line number Diff line number Diff line change
Expand Up @@ -49,7 +49,7 @@ remotes::install_github("darrennorris/testmap")

This is a basic example which shows a summary of where *Podocnemis
unifilis* is Endangered.
An example with code to make a map is here:
Another example with code to make a map is here:
<https://darrennorris.github.io/testmap/articles/testmap.html>

``` r
Expand All @@ -60,26 +60,33 @@ library(dplyr)
points_bau_ffr |>
dplyr::mutate(flag_EN = if_else(fem_diff_t42 <= -0.5, 1, 0)) |>
dplyr::group_by(COUNTRY) |>
dplyr::summarise(length_river = n(),
dplyr::summarise(pop_start = sum(fem_t0),
pop_end = sum(fem_t42),
pop_change = round(((sum(fem_t42) - sum(fem_t0)) / sum(fem_t0)), 3),
change_lcl_95 = Hmisc::smean.cl.boot(fem_diff_t42)["Lower"],
change_ucl_95 = Hmisc::smean.cl.boot(fem_diff_t42)["Upper"],
length_river = n(),
length_endangered = sum((flag_EN))) |>
ungroup() |>
mutate(proportion_endangered = round((length_endangered / length_river), 2)) |>
mutate(threat_status = case_when(proportion_endangered >= 0.8 ~ "Critically Endangered",
proportion_endangered >= 0.5 ~ "Endangered",
proportion_endangered >= 0.3 ~ "Vulnerable",
proportion_endangered >= 0.2 ~ "Near Threatened"))
#> # A tibble: 9 × 5
#> COUNTRY length_river length_endangered proportion_endangered threat_status
#> <chr> <int> <dbl> <dbl> <chr>
#> 1 Bolivia 22217 15516 0.7 Endangered
#> 2 Brazil 190555 141183 0.74 Endangered
#> 3 Colombia 38552 24122 0.63 Endangered
#> 4 Ecuador 8302 7066 0.85 Critically E…
#> 5 French Gui… 3298 2082 0.63 Endangered
#> 6 Guyana 7372 3311 0.45 Vulnerable
#> 7 Peru 47363 36750 0.78 Endangered
#> 8 Suriname 5756 2643 0.46 Vulnerable
#> 9 Venezuela 30022 16714 0.56 Endangered
dplyr::ungroup() |>
dplyr::mutate(proportion_endangered = round((length_endangered / length_river), 2)) |>
dplyr::mutate(threat_status = case_when(pop_change <= -0.8 ~ "Critically Endangered",
pop_change <= -0.5 ~ "Endangered",
pop_change <= -0.3 ~ "Vulnerable",
pop_change <= -0.2 ~ "Near Threatened"))
#> # A tibble: 9 × 10
#> COUNTRY pop_start pop_end pop_change change_lcl_95 change_ucl_95 length_river
#> <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <int>
#> 1 Bolivia 222170 94300. -0.576 -0.584 -0.567 22217
#> 2 Brazil 1905550 712133. -0.626 -0.629 -0.624 190555
#> 3 Colombia 385520 199290. -0.483 -0.489 -0.477 38552
#> 4 Ecuador 83020 18194. -0.781 -0.791 -0.771 8302
#> 5 French … 32980 17147. -0.48 -0.502 -0.458 3298
#> 6 Guyana 73720 55397. -0.249 -0.263 -0.234 7372
#> 7 Peru 473630 149614. -0.684 -0.689 -0.679 47363
#> 8 Suriname 57560 42552. -0.261 -0.278 -0.243 5756
#> 9 Venezue… 300220 185219. -0.383 -0.391 -0.376 30022
#> # ℹ 3 more variables: length_endangered <dbl>, proportion_endangered <dbl>,
#> # threat_status <chr>
```

Package developed and built using the following guides:
Expand Down
16 changes: 2 additions & 14 deletions data-raw/vector_data.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -31,27 +31,15 @@ inpoints <- readRDS(mypath)
# keep only columns needed for plotting
points_bau_ffr <- inpoints |>
filter(model_name == "modelkey_BAU") |>
mutate(flag_50_42y = factor(if_else(fem_diff_t42 <= -0.5, 1, 0)),
flag_CR_42y = if_else(fem_diff_t42 <= -0.8, 5, NA),
flag_EN_42y = if_else(fem_diff_t42 <= -0.5, 4, NA),
flag_VU_42y = if_else(fem_diff_t42 <= -0.3, 3, NA),
flag_NT_42y = if_else(fem_diff_t42 < 0, 2, NA),
flag_ok_42y = if_else(fem_diff_t42 >= 0, 1, NA),
) |>
mutate(threat_status = coalesce(flag_CR_42y, flag_EN_42y, flag_VU_42y,
flag_NT_42y, flag_ok_42y)) |>
mutate(flag_50_42y = factor(if_else(fem_diff_t42 <= -0.5, 1, 0))) |>
select(BASIN_NAME, subbasin, SUBBASIN_FLAG,
BAS_NAME, COUNTRY, RIV_ORD, BB_ID, BB_NAME, REACH_ID,
Protected, Accessible, Free.flowing,
fem_diff_t42, flag_50_42y,
threat_status,
fem_t0, fem_t42, fem_diff_t42, flag_50_42y,
geom) |>
sf::st_as_sf()
sf::st_crs(points_bau_ffr) <- NA
points_bau_ffr <- points_bau_ffr |> data.frame()
points_bau_ffr$threat_status <- as.factor(points_bau_ffr$threat_status)
# Only have two extremes: less than -0.8 or increase 0.4.
levels(points_bau_ffr$threat_status)
# export
usethis::use_data(points_bau_ffr, overwrite = TRUE)

Expand Down
Binary file modified data/points_bau_ffr.rda
View file
Binary file not shown.
114 changes: 95 additions & 19 deletions vignettes/Interactive-map.Rmd
View file
Original file line number Diff line number Diff line change
Expand Up @@ -31,12 +31,15 @@ library(testmap)

```{r load-packages, echo=FALSE, message=FALSE, warning=FALSE}
library(dplyr)
library(ggplot2)
library(leaflet)
library(leafem)
library(Hmisc)
library(sf)
library(knitr)
library(kableExtra)
library(htmltools)
library(htmltools)
library(patchwork)
```
Use the interactive map below to check population changes. Zoom in to see
where *Podocnemis unilfilis* is Endangered based on IUCN Redlist criteria - A3bd.
Expand Down Expand Up @@ -271,7 +274,7 @@ table_basin_ffr <- points_bau_ffr |>

```{r make-table-basin-ffr, echo=FALSE}
knitr::kable(table_basin_ffr,
col.names = c("Basin", "Endangered (prop)","river length (km)",
col.names = c("Basin", "population change","river length (km)",
"length End.", "length not End."))
```
Expand All @@ -287,7 +290,8 @@ table_basin_country <- points_bau |>
ungroup() |>
mutate(length_not_end = length_river - length_end,
prop_end = round((length_end / length_river), 2)) |>
select(BASIN_N, COUNTRY, prop_end, length_river, length_end, length_not_end)
select(BASIN_N, COUNTRY, prop_end, length_river, length_end, length_not_end)
```

```{r make-table-basin-country, echo=FALSE}
Expand All @@ -299,25 +303,97 @@ knitr::kable(table_basin_country,
```

Same with Free-flowing rivers.....
```{r totals-basin-country-ffr, echo=FALSE, message=FALSE, warning=FALSE}
table_basin_country_ffr <- points_bau_ffr |>
group_by(BASIN_NAME, COUNTRY) |>
mutate(flag_e = if_else(fem_diff_t42 <= -0.5, 1, 0)) |>
summarise(length_river = n(),
length_end = sum((flag_e))) |>
ungroup() |>
mutate(length_not_end = length_river - length_end,
prop_end = round((length_end / length_river), 2)) |>
select(BASIN_NAME, COUNTRY, prop_end, length_river, length_end, length_not_end)
Same with Free-flowing rivers.....plot results
```{r fig-basin-country-ffr}
# Make summaries
tab_sum <- points_bau_ffr |>
dplyr::mutate(flag_EN = if_else(fem_diff_t42 <= -0.5, 1, 0)) |>
dplyr::group_by(COUNTRY, BASIN_NAME) |>
dplyr::summarise(pop_start = sum(fem_t0),
pop_end = sum(fem_t42),
pop_change = round(((sum(fem_t42) - sum(fem_t0)) / sum(fem_t0)), 3),
diff_mean = mean(fem_diff_t42),
change_lcl_95 = Hmisc::smean.cl.boot(fem_diff_t42)["Lower"],
change_ucl_95 = Hmisc::smean.cl.boot(fem_diff_t42)["Upper"],
diff_median = median(fem_diff_t42),
diff_q25 = quantile(fem_diff_t42, probs = 0.25),
diff_q75 = quantile(fem_diff_t42, probs = 0.75),
length_river = n(),
length_endangered = sum((flag_EN))) |>
dplyr::ungroup() |>
dplyr::mutate(proportion_endangered = round((length_endangered / length_river), 2),
length_label = round((length_river / 1000), 1)
) |>
dplyr::mutate(threat_status = case_when(diff_mean <= -0.8 ~ "Critically Endangered",
diff_mean <= -0.5 ~ "Endangered",
diff_mean <= -0.3 ~ "Vulnerable",
diff_mean <= -0.2 ~ "Near Threatened"))
tab_sum$bc <- factor(paste(tab_sum$BASIN_NAME, tab_sum$COUNTRY, sep = "\n"))
levels(tab_sum$bc)
# Plot
# check where these errors come from -
# Orinoco in Brazil, Orinoco in Guyana, Coastal South in French Guiana.
fig_left <- tab_sum |>
filter(length_river > 21) |>
droplevels() |>
filter(BASIN_NAME %in% c("Amazon", "Coastal North")) |>
ggplot(aes(x = COUNTRY, y = pop_change)) +
geom_rect(data=NULL,aes(xmin=-Inf, xmax=Inf, ymin = -0.2, ymax = -0.3),
fill="#F6DABF", alpha=0.2) +
geom_rect(data=NULL,aes(xmin=-Inf, xmax=Inf, ymin = -0.3, ymax = -0.5),
fill="#DEB688", alpha=0.2) +
geom_rect(data=NULL,aes(xmin=-Inf, xmax=Inf, ymin = -0.5, ymax = -0.8),
fill="#C09355", alpha=0.2) +
geom_rect(data=NULL,aes(xmin=-Inf, xmax=Inf, ymin = -0.8, ymax = -1),
fill="#A3720E", alpha=0.2) +
geom_col(aes(fill = COUNTRY)) +
geom_errorbar(aes(ymax = change_ucl_95, ymin = change_lcl_95),
width = 0.2) +
geom_label(aes(x = COUNTRY, y = 0.2, label = length_label)) +
scale_fill_grey() +
facet_wrap(~BASIN_NAME, scales = "free_x", nrow = 2) +
theme_bw() +
labs(y = "Population change", x = "") +
#theme(legend.position = "bottom")
guides(fill = "none")
fig_right <- tab_sum |>
filter(length_river > 21) |>
droplevels() |>
filter(BASIN_NAME %in% c("Coastal South", "Orinoco")) |>
ggplot(aes(x = COUNTRY, y = pop_change)) +
geom_rect(data=NULL,aes(xmin=-Inf, xmax=Inf, ymin = -0.2, ymax = -0.3),
fill="#F6DABF", alpha=0.2) +
geom_rect(data=NULL,aes(xmin=-Inf, xmax=Inf, ymin = -0.3, ymax = -0.5),
fill="#DEB688", alpha=0.2) +
geom_rect(data=NULL,aes(xmin=-Inf, xmax=Inf, ymin = -0.5, ymax = -0.8),
fill="#C09355", alpha=0.2) +
geom_rect(data=NULL,aes(xmin=-Inf, xmax=Inf, ymin = -0.8, ymax = -1),
fill="#A3720E", alpha=0.2) +
geom_col(aes(fill = COUNTRY)) +
geom_errorbar(aes(ymax = change_ucl_95, ymin = change_lcl_95),
width = 0.2) +
geom_label(aes(x = COUNTRY, y = 0.2, label = length_label)) +
scale_fill_grey() +
facet_wrap(~BASIN_NAME, scales = "free_x", nrow = 2) +
theme_bw() +
labs(y = "", x = "") +
#theme(legend.position = "bottom")
guides(fill = "none")
# put together
fig_left + fig_right + plot_layout(widths = c(3, 1))
```


Table showing data values used in graph.

```{r make-table-basin-country-ffr, echo=FALSE}
knitr::kable(table_basin_country_ffr,
col.names = c("Basin", "Country","Endangered (prop)",
"river length (km)",
"length End.", "length not End.")) |>
kableExtra::column_spec(3:6, width = "3cm")
tab_sum |>
select(BASIN_NAME, COUNTRY, pop_change, length_river) |>
arrange(BASIN_NAME, COUNTRY) |>
knitr::kable(col.names = c("Basin", "Country", "population change",
"river length (km)")) |>
kableExtra::column_spec(3:4, width = "3cm")
```

Expand Down
6 changes: 4 additions & 2 deletions vignettes/testmap.Rmd
View file
Original file line number Diff line number Diff line change
Expand Up @@ -17,15 +17,14 @@ knitr::opts_chunk$set(
## Load packages
```{r setup, warning=FALSE, message=FALSE}
library(testmap)
library(testmap)
library(dplyr)
library(sf)
library(leaflet)
library(leafem)
```

## Make map
This is a basic example which shows a map of where *Podocnemis unifilis*
This example shows a map of where *Podocnemis unifilis*
is Endangered in French Guiana. This country was chosen for illustrative
purposes because there are relatively few river points.

Expand All @@ -46,12 +45,15 @@ leaf_pal <- colorFactor(
# interactive map. Options added to make panning smoother....
leaflet::leaflet(points_bau4326,
options = leafletOptions(preferCanvas = TRUE)) |>
# Basemap
addTiles(options = tileOptions(
updateWhenZooming = FALSE, # map won't update tiles until zoom is done
updateWhenIdle = TRUE)) |>
# Circles when zoom in.
addCircles(color = ~leaf_pal(flag_50_42y),
group = "points_bau4326_low"
) |>
# Markers with cluster options for smoother panning.
addCircleMarkers(color = ~leaf_pal(flag_50_42y),
stroke = FALSE, fillOpacity = 0.4,
clusterOptions = markerClusterOptions(),
Expand Down

0 comments on commit 01e9f61

Please sign in to comment.