Species checklist generated with the rWCVP package"

knitr::opts_chunk$set(echo = FALSE)
knitr::opts_chunk$set(warning = FALSE)
knitr::opts_chunk$set(message = FALSE)


taxa <- params$taxa
version <- params$version
input.area <- params$area_delim
df <- params$mydata
synonyms <- params$synonyms
  cat("**Generated on: **", format(Sys.time(), '%d %B, %Y'),"\n")
  cat("\n**WCVP version: **", version)

Cite as:

| Govaerts, R., Nic Lughadha, E., Black, N., Turner, R., & Paton, A. (2021). The World Checklist of | Vascular Plants, a continuously updated resource for exploring global plant diversity. Scientific | Data, 8(1), 1-10.
| | Brown, M.J.M, Black, N., Govaerts, R., Nic Lughadha, E., Ondo, I., Turner, R., Walker , B.E. (2022). | rWCVP: Generating Summaries, Reports and Plots from the World Checklist of Vascular Plants. R | package version 1.0.0. https://github.com/matildabrown/rWCVP


For compilers and reviewers of the dataset, see: https://wcsp.science.kew.org/compilersReviewers.do


if(!is.null(taxa)){
  cat("### Taxa: ", paste(taxa, collapse = " + "),  "\n")
  } else {cat("### Taxa: All \n") }
  cat("\n")
if(synonyms==TRUE) {
  cat("**Including synonyms, illegitimate, invalid and other non-accepted names.**") 
} else {cat("**Accepted names only.** ")}
  cat("\n")
if(!identical(input.area, "global"))  cat("### Geography: ", paste(get_area_name(input.area), collapse = " + "),"\n") else cat("### Geography: Global","\n")
shp <- rWCVPdata::wgsrpd3
shp$fillcol <- as.numeric(shp$LEVEL3_COD %in% input.area)+1
if(identical(input.area,"global")) shp$fillcol <- 2

suppressMessages({
suppressWarnings({
  ggplot2::ggplot(shp) +
  ggplot2::geom_sf(fill=c("gray80","#ad2b00")[shp$fillcol], col="gray80")+
  ggplot2::stat_sf_coordinates(col=c("gray80","#ad2b00")[shp$fillcol])+
  ggplot2::theme_void()+
  ggplot2::coord_sf(expand=FALSE)
  })
})
df <- params$mydata
if("X" %in% colnames(df)) df <- select(df, -X)

Symbols used in species list

data.frame(v1= c("E","e","x","i","?"), 
                      v2=c("Endemic to a single WGSPRD Level 3 area",
                           "Regionally endemic (to the input geography, above)",
                           "Considered extinct or eradicated",
                           "Introduced and naturalised",
                           "Occurrence doubtful"
                           )) %>% 
  gt::gt() %>% 
    gt::tab_options(
    data_row.padding = gt::px(1),
    data_row.padding.horizontal = gt::px(15),
    column_labels.hidden = TRUE,
    table.font.size = 12,
    table.align = "left")

Key to regions

df %>% 
  dplyr::select(area_code_l3, area, region, continent) %>% 
  {if(!identical(input.area, "global")) dplyr::filter(.,area_code_l3 %in% input.area) else unique(.)} %>% 
  unique() %>% 
  na.omit() %>% 
  dplyr::arrange(continent, region, area_code_l3) %>% 
  dplyr::group_by(continent, region) %>% 
  gt::gt() %>% 
  gt::tab_footnote(
  footnote = "For codes outside the input geography, see: https://en.wikipedia.org/wiki/List_of_codes_used_in_the_World_Geographical_Scheme_for_Recording_Plant_Distributions",
  locations = gt::cells_column_labels(
    columns = area_code_l3)
  ) %>% 
  gt::cols_label(area_code_l3 = "Area (WGSRPD Level 3)",
             area="") %>% 
  gt::tab_stubhead(label="CONTINENT - Region") %>% 
  gt::tab_options(
    row_group.as_column= TRUE,
    stub_row_group.font.weight = "bold",
    column_labels.font.weight = "bold",
    data_row.padding = gt::px(1),
    table.font.size = 12,
    table.align = "left",
    footnotes.marks = "standard") %>% 
    gt::tab_style(
        style = gt::cell_text(align = "left"),
        locations = gt::cells_row_groups()
    ) 

Basic statistics

``` {r results = 'asis', message=FALSE} if(!"in_geography" %in% colnames(df)) { df$in_geography <- 1 df$area_endemic <- 1 }

summ_df <- data.frame(area_code_l3="Region", cat=c("Total", "Endemic (to region)"), n.sp= c(nrow(unique(df %>% dplyr::filter(taxon_status == "Accepted", taxon_rank == "Species") %>% dplyr::select(taxon_name))), nrow(unique(df %>% dplyr::filter(taxon_status == "Accepted", taxon_rank == "Species", area_endemic == 1) %>% dplyr::select(taxon_name))))) %>% tidyr::pivot_wider(names_from=cat, values_from = n.sp)

if(identical(input.area,"global")) { cat("Total number of species: ", as.numeric(summ_df[1,2])) input.area <- unique(df$area_code_l3) } else { cat("Total number of species: ", as.numeric(summ_df[1,2], "\n")) cat('\n') cat("\nNumber of regionally endemic species: ", as.numeric(summ_df[1,3])) }

df_split <- df %>% dplyr::filter(area_code_l3 %in% input.area) %>% dplyr::group_by(area_code_l3) %>% dplyr::group_split() summ_split <- list() for(i in seq_along(df_split)){ native <- nrow(unique(df_split[[i]] %>% dplyr::filter(taxon_status == "Accepted", taxon_rank == "Species", introduced ==0 ) %>% dplyr::select(taxon_name))) endemic <- nrow(unique(df_split[[i]] %>% dplyr::filter(taxon_status == "Accepted", taxon_rank == "Species", endemic ==1 ) %>% dplyr::select(taxon_name))) introduced <- nrow(unique(df_split[[i]] %>% dplyr::filter(taxon_status == "Accepted", taxon_rank == "Species", introduced ==1 ) %>% dplyr::select(taxon_name))) extinct <- nrow(unique(df_split[[i]] %>% dplyr::filter(taxon_status == "Accepted", taxon_rank == "Species", extinct ==1 ) %>% dplyr::select(taxon_name))) total <- nrow(unique(df_split[[i]] %>% dplyr::filter(taxon_status == "Accepted", taxon_rank == "Species") %>% dplyr::select(taxon_name)))

summ_split[[i]] <- data.frame(l3=df_split[[i]][1,"area_code_l3"],
                              cat=c("Native",
                                    "Endemic",
                                    "Introduced",
                                    "Extinct",
                                    "Total"),
                              n.sp=c(native,
                                    endemic,
                                    introduced,
                                    extinct,
                                    total))

}

summ <- do.call(rbind, summ_split)

suppressMessages(summ %>% tidyr::pivot_wider(names_from = cat, values_from = n.sp) %>% dplyr::left_join(df %>% dplyr::select(continent, region, area_code_l3)) %>% dplyr::arrange(continent, region, area_code_l3) %>% dplyr::select(-continent) %>% dplyr::group_by(region) %>% unique() %>% na.omit() %>% gt::gt() %>% gt::tab_options( row_group.as_column= TRUE, stub_row_group.font.weight = "bold", column_labels.font.weight = "bold", data_row.padding = gt::px(1), table.font.size = 12, table_body.hlines.color = "transparent", table.align = "left") %>% gt::tab_style( style = gt::cell_text(align = "left"), locations = gt::cells_row_groups() ) %>% gt::cols_label(area_code_l3 = "Area") %>% gt::tab_style( style=gt::cell_text(weight="bold"), locations = gt::cells_body( columns= Total ) ) %>% gt::text_transform( locations = gt::cells_body(), fn = function(x){ ifelse(x == 0, "", x) } ) )

### List of species

```r
textkey <- data.frame(introduced=c(0,1,1,0,0,1,1,0), extinct=c(0,1,0,1,0,1,0,1), location_doubtful=c(0,1,0,0,1,0,1,1), text=c("","(i,x,d)","(i)","(x)","(d)","(i,x)","(i,d)","(x,d)"))

suppressMessages({ 
  df <- dplyr::left_join(df, textkey)
df$area_text <- paste0(df$area_code_l3, df$text)

df_area_key <- unique(df[, c("continent_code_l1","continent","region_code_l2", "region", "area_code_l3", "area")])

distvars <- c("continent_code_l1","continent","region_code_l2", "region", "area_code_l3", "area","text")

df2 <- df %>%   dplyr::arrange(continent, region, area_code_l3, taxon_name) %>% 
  dplyr::select(-dplyr::any_of(distvars)) %>% 
  dplyr::group_by(plant_name_id) %>% 
  dplyr::summarise(
    area_text = paste(area_text, collapse=", "))


df3 <- df %>% 
  dplyr::select(-any_of(c(distvars, "area_text"))) %>% 
  dplyr::left_join(df2) %>% 
  unique()

df3$area_text[which(df3$area_text  %in% c("","NANA"))] <- NA

df3$genus_text <- df3$genus
df3$genus_text[which(df3$taxon_status=="Accepted")] <- paste("<b><em>", df3$genus[which(df3$taxon_status=="Accepted")], "</b></em>")
df3$species_text <- df3$species
df3$species_text[which(df3$taxon_status=="Accepted")] <- paste("<b><em>", df3$species[which(df3$taxon_status=="Accepted")], "</b></em>")
df3$species_hybrid_text <- df3$species_hybrid
df3$species_hybrid_text[which(df3$taxon_status=="Accepted" & !is.na(df3$species_hybrid))] <- paste("<b>", df3$species_hybrid[which(df3$taxon_status=="Accepted"& !is.na(df3$species_hybrid))], "</b>")
df3$infraspecific_rank_text <- df3$infraspecific_rank
df3$infraspecific_rank_text[which(df3$taxon_status=="Accepted" & !is.na(df3$infraspecific_rank))] <- paste(" <b>", df3$infraspecific_rank_text[which(df3$taxon_status=="Accepted" & !is.na(df3$infraspecific_rank))], "</b>")
df3$infraspecies_text <- df3$infraspecies
df3$infraspecies_text[which(df3$taxon_status=="Accepted" & !is.na(df3$infraspecies))] <- paste(" <b><em>", df3$infraspecies_text[which(df3$taxon_status=="Accepted" & !is.na(df3$infraspecies))], "</b></em>")
df3$maintext <- paste(df3$genus_hybrid, df3$genus_text,  " ", df3$species_hybrid_text, df3$species_text, df3$infraspecific_rank_text, df3$infraspecies_text, " ", df3$taxon_authors)
df3$maintext[which(df3$taxon_status != "Accepted")] <- paste0(df3$maintext[which(df3$taxon_status != "Accepted")], " [",df3$taxon_status[which(df3$taxon_status != "Accepted")] ,"]")

df3$maintext <- paste(df3$maintext, df3$place_of_publication, df3$volume_and_page, df3$first_published)
df3$maintext[which(df3$taxon_name != df3$accepted_name & !is.na(df3$accepted_name))] <- paste0(df3$maintext[which(df3$taxon_name != df3$accepted_name & !is.na(df3$accepted_name))], 
         " = <b><em>", df3$accepted_name[which(df3$taxon_name != df3$accepted_name & !is.na(df3$accepted_name))], "</em></b>")

df3$maintext <- gsub("NA ", "", df3$maintext)
df3$maintext <- gsub(" NA", "", df3$maintext)

df3$maintext[which(!is.na(df3$area_text))] <- paste0(df3$maintext[which(!is.na(df3$area_text))], "<br>     ",df3$area_text[which(!is.na(df3$area_text))] )


df3 <- df3 %>% dplyr::mutate(endemic_flag=dplyr::case_when(endemic==1 ~ "E",
                                             area_endemic==1 & endemic==0 ~ "e",
                                             TRUE ~ ""))

df3 %>% dplyr::filter(taxon_rank!= "Genus") %>% 
  dplyr::select(family, endemic_flag, maintext, plant_name_id, ipni_id) %>% 
  dplyr::group_by(family) %>% 
  unique() %>% 
  gt::gt() %>% 
  gt::text_transform(
    locations = gt::cells_body(columns = maintext),
    fn = function(x){
      purrr::map(x, html, replace_sign_entities = TRUE)
    }
  ) %>% 
  gt::tab_options(
    row_group.font.weight = "bold",
    row_group.font.size = 14,
    table.font.size = 12,
    data_row.padding = gt::px(1),
    column_labels.hidden = TRUE
  )  %>% 
    gt::tab_style(
        style = gt::cell_text(size = 8),
        locations = gt::cells_body(columns = plant_name_id)
    )  %>% 
    gt::tab_style(
        style = gt::cell_text(size = 8),
        locations = gt::cells_body(columns = ipni_id)
    ) %>% 
  gt::tab_style(
       style = gt::cell_borders(sides = "all", color = "transparent"),
       locations = gt::cells_body())
})


Try the rWCVP package in your browser

Any scripts or data that you put into this service are public.

rWCVP documentation built on Feb. 16, 2023, 8:30 p.m.