Skip to content

Commit

Permalink
Updates to figures based on latest data
Browse files Browse the repository at this point in the history
  • Loading branch information
@casanchez
casanchez committed Dec 19, 2023
1 parent aa44e06 commit 75ae4cb
Show file tree
Hide file tree
Showing 6 changed files with 122 additions and 105 deletions.
4 changes: 2 additions & 2 deletions R/build_sdm.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -21,8 +21,8 @@ build_sdm <- function(species, occs, iucn_ranges, env_stack, n_bg, seed = 42){
# subset all occurrence points to those of the focal species
occs_species <- occs %>%
filter(name == species)
occs_sf <- st_as_sf(occs_species, coords = c("longitude", "latitude"),
crs = "+proj=longlat +datum=WGS84 +ellps=WGS84 +towgs84=0,0,0")
occs_sf <- sf::st_as_sf(occs_species, coords = c("longitude", "latitude"),
crs = "+proj=longlat +datum=WGS84 +ellps=WGS84 +towgs84=0,0,0")
occs_xy <- occs_species[, c("longitude", "latitude")]

# build convex hull around focal species points
Expand Down
20 changes: 5 additions & 15 deletions R/get_iucn.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -3,7 +3,7 @@
#'
#' @title get_iucn
#' @param IUCN_data mammal distribution data from IUCN
#' @param species character, species of interest
#' @param species character, names of species of interest
#' @return
#' @author Cecilia Sanchez
#' @example
Expand All @@ -13,20 +13,10 @@ get_iucn <- function(IUCN_data, species){

mammals <- terra::vect(IUCN_data)

# tedious but only way I could get this to work
iucn_ranges <- subset(mammals, mammals[[2]] == species[1] |
mammals[[2]] == species[2] |
mammals[[2]] == species[3] |
mammals[[2]] == species[4] |
mammals[[2]] == species[5] |
mammals[[2]] == species[6] |
mammals[[2]] == species[7] |
mammals[[2]] == species[8] |
mammals[[2]] == species[9] |
mammals[[2]] == species[10] |
mammals[[2]] == species[11] |
mammals[[2]] == species[12]
)
iucn_ranges <- terra::subset(mammals, mammals$sci_name %in% species)

# free memory
gc()

return(iucn_ranges)

Expand Down
48 changes: 26 additions & 22 deletions R/map_predicted_distributions.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -23,7 +23,7 @@ map_predicted_distributions <- function(){
# subset the full countries map to just WA countries
WA_countries <- countries[countries$GID_0 %in% WA_codes]
# make an sf object for later plotting
WA_countries_sf <- st_as_sf(WA_countries)
WA_countries_sf <- sf::st_as_sf(WA_countries)

# get list of all generated predictions rasters
bat_ras_names <- list.files(path = "outputs/", pattern = "full",
Expand All @@ -41,44 +41,48 @@ map_predicted_distributions <- function(){
# crop/mask to WA countries
bat_ras_cropped <- terra::crop(bat_ras, WA_countries, mask = T)
# align CRS
crs(bat_ras_cropped) <- crs(WA_countries)
terra::crs(bat_ras_cropped) <- terra::crs(WA_countries)

# plot using tidyterra functionality
maps_list[[i]] <- ggplot() +
geom_spatvector(data = WA_countries, fill = "gray95") +
geom_spatraster(data = bat_ras_cropped) +
tidyterra::geom_spatvector(data = WA_countries, fill = "gray95") +
tidyterra::geom_spatraster(data = bat_ras_cropped) +
scale_fill_viridis_c(option = "D", na.value = "transparent",
name = "Predicted probability \nof species presence",
breaks = c(0, 0.2, 0.4, 0.6, 0.8, 1)) +
geom_spatvector(data = WA_countries, fill = "transparent", lwd = 0.5) +
tidyterra::geom_spatvector(data = WA_countries, fill = "transparent",
lwd = 0.5) +
labs(x = "Longitude", y = "Latitude") +
ggtitle(species_name) +
theme_bw() +
theme(axis.text = element_text(color = "black"))
}

# create initial grid with no legends
plot_grid(maps_list[[1]] + theme(legend.position = "none"),
maps_list[[2]] + theme(legend.position = "none"),
maps_list[[3]] + theme(legend.position = "none"),
maps_list[[4]] + theme(legend.position = "none"),
maps_list[[5]] + theme(legend.position = "none"),
maps_list[[6]] + theme(legend.position = "none"),
maps_list[[7]] + theme(legend.position = "none"),
maps_list[[8]] + theme(legend.position = "none"),
maps_list[[9]] + theme(legend.position = "none"),
maps_list[[10]] + theme(legend.position = "none"),
maps_list[[11]] + theme(legend.position = "none"),
maps_list[[12]] + theme(legend.position = "none"),
ncol = 3) -> my_grid
cowplot::plot_grid(maps_list[[1]] + theme(legend.position = "none"),
maps_list[[2]] + theme(legend.position = "none"),
maps_list[[3]] + theme(legend.position = "none"),
maps_list[[4]] + theme(legend.position = "none"),
maps_list[[5]] + theme(legend.position = "none"),
maps_list[[6]] + theme(legend.position = "none"),
maps_list[[7]] + theme(legend.position = "none"),
maps_list[[8]] + theme(legend.position = "none"),
maps_list[[9]] + theme(legend.position = "none"),
maps_list[[10]] + theme(legend.position = "none"),
maps_list[[11]] + theme(legend.position = "none"),
maps_list[[12]] + theme(legend.position = "none"),
maps_list[[13]] + theme(legend.position = "none"),
maps_list[[14]] + theme(legend.position = "none"),
maps_list[[15]] + theme(legend.position = "none"),
ncol = 3) -> my_grid

# make one legend to go at the bottom
legend_below <- get_legend(maps_list[[1]] +
guides(color = guide_legend(nrow = 1)) +
theme(legend.position = "bottom"))
legend_below <- cowplot::get_legend(maps_list[[1]] +
guides(color = guide_legend(nrow = 1)) +
theme(legend.position = "bottom"))

# add initial grid plus the single legend
plot_grid(my_grid, legend_below, ncol = 1, rel_heights = c(1, 0.1))
cowplot::plot_grid(my_grid, legend_below, ncol = 1, rel_heights = c(1, 0.1))


rm(list = "bat_ras", "bat_ras_cropped", "countries", "WA_countries",
Expand Down
48 changes: 20 additions & 28 deletions _targets.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -19,7 +19,7 @@ tar_option_set(

## Data input
data_input_targets <- tar_plan(
tar_file(CoV_species_file, "data/Habitat info - CoV+ Western Asia bat species - updated 29 June 2023.csv"),
tar_file(CoV_species_file, "data/Habitat info - CoV+ Western Asia bat species - updated 11 Dec 2023.csv"),
tar_file(WABNet_coords_file, "data/GPS coordinates for WABNet captured species.csv"),
# https://figshare.com/articles/dataset/Metadata_for_DarkCideS_1_0_a_global_database_for_bats_in_karsts_and_caves/16413405?file=34091939
tar_file(darkcides_file, "data/DarkCideS_v4_dataset 2.csv"),
Expand Down Expand Up @@ -57,6 +57,7 @@ data_processing_targets <- tar_plan(
karst_file, ntl_file)),

CoV_species_names = CoV_species$Species,
# takes a couple hours
occs_df = get_occs(species_names = CoV_species_names,
sources = c("gbif", "vertnet"),
limit = 30000),
Expand All @@ -82,30 +83,35 @@ data_processing_targets <- tar_plan(

## Analysis
analysis_targets <- tar_plan(

e_Hysa = build_sdm(species = "Hypsugo savii", occs = occs_ENM,
iucn_ranges, env_stack, n_bg = 10000),
e_Misc = build_sdm(species = "Miniopterus schreibersii", occs = occs_ENM,
iucn_ranges, env_stack, n_bg = 10000),
e_Mybl = build_sdm(species = "Myotis blythii", occs = occs_ENM, iucn_ranges,
e_Mybl = build_sdm(species = "Myotis blythii", occs = occs_ENM, iucn_ranges,
env_stack, n_bg = 10000),
e_Myem = build_sdm(species = "Myotis emarginatus", occs = occs_ENM,
e_Myem = build_sdm(species = "Myotis emarginatus", occs = occs_ENM,
iucn_ranges, env_stack, n_bg = 10000),
e_Mymy = build_sdm(species = "Myotis myotis", occs = occs_ENM, iucn_ranges,
e_Mymy = build_sdm(species = "Myotis myotis", occs = occs_ENM, iucn_ranges,
env_stack, n_bg = 10000),
e_Piku = build_sdm(species = "Pipistrellus kuhlii", occs = occs_ENM,
e_Pija = build_sdm(species = "Pipistrellus javanicus", occs = occs_ENM,
iucn_ranges, env_stack, n_bg = 10000),
e_Piku = build_sdm(species = "Pipistrellus kuhlii", occs = occs_ENM,
iucn_ranges, env_stack, n_bg = 10000),
e_Rhbl = build_sdm(species = "Rhinolophus blasii", occs = occs_ENM,
e_Plma = build_sdm(species = "Plecotus macrobullaris", occs = occs_ENM,
iucn_ranges, env_stack, n_bg = 10000),
e_Rheu = build_sdm(species = "Rhinolophus euryale", occs = occs_ENM,
e_Rhbl = build_sdm(species = "Rhinolophus blasii", occs = occs_ENM,
iucn_ranges, env_stack, n_bg = 10000),
e_Rhfe = build_sdm(species = "Rhinolophus ferrumequinum", occs = occs_ENM,
e_Rheu = build_sdm(species = "Rhinolophus euryale", occs = occs_ENM,
iucn_ranges, env_stack, n_bg = 10000),
e_Rhmi = build_sdm(species = "Rhinopoma microphyllum", occs = occs_ENM,
e_Rhfe = build_sdm(species = "Rhinolophus ferrumequinum", occs = occs_ENM,
iucn_ranges, env_stack, n_bg = 10000),
e_Roae = build_sdm(species = "Rousettus aegyptiacus", occs = occs_ENM,
e_Rhmi = build_sdm(species = "Rhinopoma microphyllum", occs = occs_ENM,
iucn_ranges, env_stack, n_bg = 10000),
e_Role = build_sdm(species = "Rousettus leschenaultii", occs = occs_ENM,
e_Roae = build_sdm(species = "Rousettus aegyptiacus", occs = occs_ENM,
iucn_ranges, env_stack, n_bg = 10000),
e_Sche = build_sdm(species = "Scotophilus heathii", occs = occs_ENM,
e_Role = build_sdm(species = "Rousettus leschenaultii", occs = occs_ENM,
iucn_ranges, env_stack, n_bg = 10000),
e_Sche = build_sdm(species = "Scotophilus heathii", occs = occs_ENM,
iucn_ranges, env_stack, n_bg = 10000)
)

Expand All @@ -116,25 +122,11 @@ outputs_targets <- tar_plan(
quarterly_heatmap = plot_quarterly_heatmap(heat_data)
)


## Report
report_targets <- tar_plan(
## Example Rmarkdown report target/s; delete and replace with your own
## Rmarkdown report target/s

# tar_render(
# example_report, path = "reports/example_report.Rmd",
# output_dir = "outputs", knit_root_dir = here::here()
# )
)


# List targets -----------------------------------------------------------------

list(
data_input_targets,
data_processing_targets,
analysis_targets,
outputs_targets,
report_targets
outputs_targets
)
Loading

0 comments on commit 75ae4cb

Please sign in to comment.