-
Notifications
You must be signed in to change notification settings - Fork 0
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
- Loading branch information
1 parent
e7b3fb9
commit 248f7a5
Showing
42 changed files
with
1,428 additions
and
426 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -1,6 1,6 @@ | ||
| Package: ppendemic | ||
| Title: A Glimpse at the Diversity of Peru's Endemic Plants | ||
| Version: 0.1.7 | ||
| Version: 0.1.8 | ||
| Authors@R: | ||
| c(person(given = "Paul E.", | ||
| family = "Santos Andrade", | ||
|
|
@@ -19,15 19,17 @@ BugReports: https://github.com/PaulESantos/ppendemic/issues/ | |
| Suggests: knitr, rmarkdown, testthat (>= 3.0.0) | ||
| Encoding: UTF-8 | ||
| LazyData: true | ||
| RoxygenNote: 7.2.3 | ||
| RoxygenNote: 7.3.2 | ||
| Depends: R (>= 3.5.0), | ||
| Config/testthat/edition: 3 | ||
| Maintainer: Paul E. Santos Andrade <[email protected]> | ||
| Imports: assertthat, dplyr, fuzzyjoin, memoise, progress, purrr, readr, | ||
| stringr, tibble, tidyr | ||
| NeedsCompilation: no | ||
| Packaged: 2023-08-15 02:26:15 UTC; user | ||
| Packaged: 2024-07-14 04:31:52 UTC; PC | ||
| Author: Paul E. Santos Andrade [aut, cre] | ||
| (<https://orcid.org/0000-0002-6635-0375>), | ||
| Lucely L. Vilca Bustamante [aut] | ||
| (<https://orcid.org/0000-0002-5559-1296>) | ||
| Repository: CRAN | ||
| Date/Publication: 2023-08-15 07:20:02 UTC | ||
| Date/Publication: 2024-07-14 04:50:02 UTC | ||
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -1,2 1,2 @@ | ||
| YEAR: 2023 | ||
| COPYRIGHT HOLDER: ppendemic authors | ||
| YEAR: 2023 | ||
| COPYRIGHT HOLDER: ppendemic authors |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -1,4 1,4 @@ | ||
| # Generated by roxygen2: do not edit by hand | ||
|
|
||
| export(get_ppendemic_data) | ||
| export(is_ppendemic) | ||
| export(matching_ppendemic) |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 1,52 @@ | ||
| #' Direct Match | ||
| #' | ||
| #' @description | ||
| #' This function performs a direct match of species names. It matches the genus and species if the name is binomial, and matches the genus, species, and infra species if the name includes a subspecies. | ||
| #' | ||
| #' @param df A tibble containing the species data to be matched. | ||
| #' @param target_df A tibble representing the ppendemic database containing the reference list of endemic species. | ||
| #' | ||
| #' @return | ||
| #' A tibble with an additional logical column direct_match indicating whether the binomial or trinomial name was successfully matched (`TRUE`) or not (`FALSE`). | ||
| #' | ||
| #' @keywords internal | ||
| direct_match <- function(df, target_df = NULL){ | ||
| assertthat::assert_that(all(c('Orig.Genus', | ||
| 'Orig.Species', | ||
| 'Orig.Infraspecies') %in% | ||
| colnames(df))) | ||
|
|
||
| ## solve issue of empty input tibble, and needed to ensure | ||
| ## compatilbility with sequential_matching: because there the | ||
| ## columns already exists for the second backbone | ||
| if(!all(c('direct_match') %in% colnames(df))){ | ||
| if(nrow(df) == 0){ | ||
| return(tibble::add_column(df, direct_match = NA)) | ||
| } | ||
| } | ||
|
|
||
| matched <- df |> | ||
| dplyr::semi_join(target_df, | ||
| by = c('Orig.Genus' = 'Genus', | ||
| 'Orig.Species' = 'Species', | ||
| 'Orig.Infraspecies' = 'infraspecies')) |> | ||
| dplyr::mutate(Matched.Genus = Orig.Genus, | ||
| Matched.Species = Orig.Species, | ||
| Matched.Infraspecies = Orig.Infraspecies) | ||
| unmatched <- df |> | ||
| dplyr::anti_join( target_df, | ||
| c('Orig.Genus' = 'Genus', | ||
| 'Orig.Species' = 'Species', | ||
| 'Orig.Infraspecies' = 'infraspecies')) | ||
|
|
||
| assertthat::assert_that(nrow(df) == (nrow(matched) nrow(unmatched))) | ||
|
|
||
| # combine matched and unmatched and add Boolean indicator: TRUE = matched, FALSE = unmatched | ||
| combined <- dplyr::bind_rows(matched, unmatched, | ||
| .id = 'direct_match') |> | ||
| dplyr::mutate(direct_match = (direct_match == 1)) |> ## convert to Boolean | ||
| dplyr::relocate(c('Orig.Genus', 'Orig.Species', 'Orig.Infraspecies')) | ||
| ## Genus & Species column at the beginning of tibble | ||
|
|
||
| return(combined) | ||
| } |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 1,71 @@ | ||
| #' Direct Match Species within Genus | ||
| #' | ||
| #' @description | ||
| #' This function performs a direct match of specific epithets within an already matched genus from the list of endemic species in the ppendemic database. | ||
| #' | ||
| #' @param df A tibble containing the species data to be matched. | ||
| #' @param target_df A tibble representing the ppendemic database containing the reference list of endemic species. | ||
| #' | ||
| #' @return | ||
| #' A tibble with an additional logical column indicating whether the specific epithet was successfully matched within the matched genus (`TRUE`) or not (`FALSE`). | ||
| #' | ||
| #' @keywords internal | ||
| direct_match_species_within_genus_helper <- function(df, target_df){ | ||
| # subset database | ||
| genus <- df |> | ||
| dplyr::distinct(Matched.Genus) |> | ||
| unlist() | ||
|
|
||
| database_subset <- memoised_get_trees_of_genus(genus, target_df) | ||
|
|
||
|
|
||
| # match specific epithet within genus | ||
| matched <- df |> | ||
| dplyr::semi_join(database_subset, | ||
| by = c('Orig.Species' = 'Species')) |> | ||
| dplyr::mutate(Matched.Species = Orig.Species) | ||
|
|
||
| unmatched <- df |> | ||
| dplyr::anti_join(database_subset, | ||
| by = c('Orig.Species' = 'Species')) | ||
|
|
||
| assertthat::assert_that(nrow(df) == (nrow(matched) nrow(unmatched))) | ||
|
|
||
| # combine matched and unmatched and add Boolean indicator: TRUE = matched, FALSE = unmatched | ||
| combined <- dplyr::bind_rows(matched, unmatched, | ||
| .id = 'direct_match_species_within_genus') |> | ||
| dplyr::mutate(direct_match_species_within_genus = (direct_match_species_within_genus == 1)) |> ## convert to Boolean | ||
| dplyr::relocate(c('Orig.Genus', | ||
| 'Orig.Species', | ||
| 'Orig.Infraspecies')) ## Genus & Species column at the beginning of tibble | ||
|
|
||
| return(combined) | ||
| } | ||
|
|
||
|
|
||
| direct_match_species_within_genus <- function(df, target_df = NULL){ | ||
|
|
||
| assertthat::assert_that(all(c('Orig.Genus', 'Orig.Species', | ||
| 'Orig.Infraspecies', | ||
| 'Matched.Genus') %in% colnames(df))) | ||
|
|
||
| ## solve issue of empty input tibble, and needed to ensure compatilbility with sequential_matching: because there the columns already exists for the second backbone | ||
| if(nrow(df) == 0){ | ||
| if(!all(c('direct_match_species_within_genus') %in% colnames(df))){ | ||
| return(tibble::add_column(df, | ||
| direct_match_species_within_genus = NA)) | ||
| } | ||
| else{ | ||
| return(df) | ||
| } | ||
| } | ||
|
|
||
| res <- df |> | ||
| dplyr::group_by(Matched.Genus) |> | ||
| dplyr::group_split() |> | ||
| map_dfr_progress(direct_match_species_within_genus_helper, | ||
| target_df) | ||
|
|
||
| return(res) | ||
| } | ||
|
|
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 1,97 @@ | ||
| #' Fuzzy Match Genus Name | ||
| #' | ||
| #' @description | ||
| #' This function performs a fuzzy match of genus names against the ppendemic database using fuzzyjoin::stringdist() to account for slight variations in spelling. | ||
| #' | ||
| #' @param df A tibble containing the genus names to be matched. | ||
| #' @param target_df A tibble representing the ppendemic database containing the reference list of endemic species. | ||
| #' | ||
| #' @return | ||
| #' A tibble with two additional columns: | ||
| #' - fuzzy_match_genus: A logical column indicating whether the genus was successfully matched (`TRUE`) or not (`FALSE`). | ||
| #' - fuzzy_genus_dist: A numeric column representing the distance for each match. | ||
| #' | ||
| #' @keywords internal | ||
| fuzzy_match_genus <- function(df, target_df = NULL){ | ||
| assertthat::assert_that(all(c('Orig.Genus', | ||
| 'Orig.Species', | ||
| 'Orig.Infraspecies') %in% colnames(df))) | ||
|
|
||
| ## solve issue of empty input tibble, and needed to ensure compatilbility with sequential_matching: because there the columns already exists for the second backbone | ||
| if(nrow(df) == 0){ | ||
| if(!all(c('fuzzy_match_genus', 'fuzzy_genus_dist') %in% colnames(df))){ | ||
| return(tibble::add_column(df, fuzzy_match_genus = NA, fuzzy_genus_dist = NA)) | ||
| } | ||
| else{ | ||
| return(df) | ||
| } | ||
| } | ||
| ## solve issue in second iteration of sequential_matching: necessary to remove fuzzy_species_dist column: otherwise 2 columns are generated 'fuzzy_species_dist...1, fuzzy_species_dist...2' | ||
| if('fuzzy_genus_dist' %in% colnames(df)){ | ||
| df <- df |> | ||
| dplyr::mutate(fuzzy_genus_dist = NULL) | ||
| } ## TODO: can potentially be removed again???? | ||
|
|
||
| Tree.Genera <- target_df |> | ||
| dplyr::distinct(Genus) | ||
| # fuzzy match | ||
| matched_temp <- df |> | ||
| fuzzyjoin::stringdist_left_join(Tree.Genera, | ||
| by = c('Orig.Genus' = 'Genus'), | ||
| max_dist = 1, | ||
| distance_col = 'fuzzy_genus_dist') |> | ||
| # save matched Genus name to Matched.Genus | ||
| dplyr::mutate(Matched.Genus = Genus) |> | ||
| dplyr::select(-c('Genus')) |> | ||
| dplyr::group_by(Orig.Genus, Orig.Species) |> | ||
| dplyr::filter(fuzzy_genus_dist == min(fuzzy_genus_dist)) | ||
|
|
||
|
|
||
| ## If there are multiple matches for the same genus: raise warning and advise for manual checking | ||
| if(matched_temp |> | ||
| dplyr::filter(dplyr::n() > 1) |> | ||
| nrow() > 0){ | ||
| message("Multiple fuzzy matches for genera with similar string distance: | ||
| Please consider curating the ambiguous entries by hand and re-run the pipeline. | ||
| The ambiguous matched genera were saved to 'treemendous_ambiguous_genera.csv' in the current working directory. | ||
| The algorithm will choose the first genus to continue.") | ||
| #Do you want save a list of the ambiguous matched genera current working directory in 'treemendous_ambiguous_genera.csv'?") | ||
| ## Save ambiguous genera for manual curation: | ||
| matched_temp |> | ||
| dplyr::filter(dplyr::n() > 1) |> | ||
| dplyr::select(Genus.x, Species, Matched.Genus) |> | ||
| readr::write_csv(file = 'ambiguous_genera.csv') ## | ||
| ## Alternative Idea: prompt the user to insert the correct name. Caution here however because this might cause trouble with unit testing | ||
| } | ||
|
|
||
| ## continue selecting first genus if more than one match | ||
| matched <- matched_temp |> | ||
| dplyr::group_modify( | ||
| ~ifelse(nrow(.x) == 0, | ||
| return(.x), | ||
| return(dplyr::slice_head(.x,n = 1))) | ||
| ## In cases of multiple matches: we choose first match. | ||
| ## Alternatively could use something more sophisticated here: | ||
| ## like for instance choosing the one with more support (present | ||
| ## in more databases) | ||
| ) |> | ||
| dplyr::ungroup() | ||
|
|
||
|
|
||
| unmatched <- df |> | ||
| fuzzyjoin::stringdist_anti_join(Tree.Genera, | ||
| by = c('Orig.Genus' = 'Genus'), | ||
| max_dist = 1) | ||
| #unmatched | ||
| assertthat::assert_that(nrow(df) == (nrow(matched) nrow(unmatched))) | ||
|
|
||
| res <- dplyr::bind_rows(matched, unmatched, | ||
| .id = 'fuzzy_match_genus') |> | ||
| dplyr::mutate(fuzzy_match_genus = (fuzzy_match_genus == 1)) |> ## convert to Boolean | ||
| dplyr::arrange(Orig.Genus, Orig.Species) |> | ||
| dplyr::relocate(c('Orig.Genus', | ||
| 'Orig.Species', | ||
| 'Orig.Infraspecies')) ## Genus & Species column at the beginning of tibble | ||
| #res | ||
| return(res) | ||
| } |
Oops, something went wrong.