A_07_Predictors_IUCN.R

A - 07: Get IUCN status for species

Source 00_Configuration.R

Code

source(here::here("Code/00_Configuration.R"))
x <- lapply(package_list, require, character = TRUE)
rm(x)


tax_path <-
  here("Data/input/Tax_lookup.csv")

Load taxonomic look up table

Code

Tax <-
  read_csv(tax_path) %>%
  distinct(verbatimIdentification, scientificName)

Get IUCN status (1)

Code

IUCN.list <-
  iucn_summary(unique(Tax$scientificName),
               distr.detail = F,
               key = Sys.getenv('IUCN_REDLIST_KEY'), 
               quiet = TRUE)

Extract codes

Code

IUCN <- lapply(names(IUCN.list), function(name) {
  item <- IUCN.list[[name]]
  # Check if the element is a list and contains `red_list_category`
  if (is.list(item) && !is.null(item$red_list_category) && !is.null(item$red_list_category$code)) {
    return(data.frame(name = name, code = item$red_list_category$code, stringsAsFactors = FALSE))
  } else {
    return(data.frame(name = name, code = NA, stringsAsFactors = FALSE)) # Fill missing with NA
  }
}) %>% 
  do.call(rbind, .) # bind to dataframe

Check NA species

Code

species_with_NA <-
  IUCN %>% filter(is.na(code))

length(species_with_NA$name)

[1] 23

Get IUCN status for species with NA codes (2)

Code

IUCN.list2 <-
  iucn_summary(unique(species_with_NA$name),
               distr.detail = F,
               key = Sys.getenv('IUCN_REDLIST_KEY'), 
               quiet = TRUE)

IUCN2 <- lapply(names(IUCN.list2), function(name) {
  item <- IUCN.list2[[name]]
  # Check if the element is a list and contains `red_list_category`
  if (is.list(item) && !is.null(item$red_list_category) && !is.null(item$red_list_category$code)) {
    return(data.frame(name = name, code = item$red_list_category$code, stringsAsFactors = FALSE))
  } else {
    return(data.frame(name = name, code = NA, stringsAsFactors = FALSE)) # Fill missing with NA
  }
}) %>% do.call(rbind, .)

Merge results and fix Nannopterum auritus code

Code

IUCN_merged <- rbind(IUCN %>% na.omit(), IUCN2) %>%
  unique() %>%
  mutate(code = case_when(name == "Nannopterum auritus" ~ "LC",
                          .default = code))


IUCN_merged %>% filter(is.na(code))

                                        name code
121                          Curruca nisoria <NA>
2110      Anas platyrhynchos x Anas rubripes <NA>
2210 Vermivora chrysoptera x Vermivora pinus <NA>

Reshape results

Code

IUCN_df <-
  as.data.frame(IUCN_merged,
                row.names = c(IUCN_merged$name)) %>%
  rownames_to_column(var = "scientificName") %>%
  right_join(Tax) %>%
  distinct(verbatimIdentification, scientificName, code)

head(IUCN_df)

   verbatimIdentification          scientificName code
1 Nucifraga caryocatactes Nucifraga caryocatactes   LC
2      Anas platyrhynchos      Anas platyrhynchos   LC
3         Aythya fuligula         Aythya fuligula   NT
4           Ciconia nigra           Ciconia nigra   LC
5     Carduelis carduelis     Carduelis carduelis   LC
6         Passer montanus         Passer montanus   LC

Save results to .rds

Code

saveRDS(IUCN_df,
        here::here("Data/output/A_predictors/IUCN_2025_03_25.rds"))