diff --git a/R/galah_download.R b/R/galah_download.R index 1bfd59c..622378a 100644 --- a/R/galah_download.R +++ b/R/galah_download.R @@ -166,21 +166,20 @@ retrieve_data <- function(taxon, get_establishment_status <- function(ala_cleaned, taxon = taxon) { if (taxon == "Plantae") { resources <- APCalign::load_taxonomic_resources() + suppressWarnings( lookup <- APCalign::native_anywhere_in_australia(unique(ala_cleaned$Species), resources = resources) + ) lookup <- dplyr::rename(lookup, Species = species) ala_cleaned <- ala_cleaned |> dplyr::left_join(lookup, by = dplyr::join_by("Species")) - - return(ala_cleaned) } if (taxon %in% c("Cicadoidea", "Marsupialia", "Odonata", "Papilionoidea")) { ala_cleaned$native_anywhere_in_aus <- "native" ala_cleaned$native_anywhere_in_aus[ala_cleaned$Species %in% c("Danaus plexippus", "Pieris rapae")] <- "introduced" - return(ala_cleaned) } if (!taxon %in% c("Cicadoidea", "Marsupialia", @@ -189,6 +188,9 @@ get_establishment_status <- function(ala_cleaned, taxon = taxon) { "Plantae")) { ala_cleaned$native_anywhere_in_aus <- "unknown" } + # Rename native_anywhere_in_aus + ala_cleaned <- dplyr::rename(ala_cleaned,"Establishment means" = native_anywhere_in_aus) + return(ala_cleaned) } @@ -211,7 +213,7 @@ process_data <- function(data) { !stringr::str_detect(species, "spec.$") ) |> dplyr::mutate( - voucher_location = dplyr::if_else(!is.na(references), references, institutionCode), + repository = dplyr::if_else(!is.na(references), references, institutionCode), voucher_type = dplyr::case_when( basisOfRecord == "PRESERVED_SPECIMEN" ~ "Collection", !is.na(sounds) ~ "Audio", @@ -232,10 +234,13 @@ process_data <- function(data) { lat, long, voucher_type, - voucher_location, + repository, recordedBy, recordID ) |> + dplyr::mutate(link = dplyr::case_when(grepl("https", repository) ~ repository, + TRUE ~ paste0("https://biocache.ala.org.au/occurrences/", recordID)) + ) |> janitor::clean_names("title") } diff --git a/R/infinitylists-package.R b/R/infinitylists-package.R index 9c6f9a9..8b3f3ee 100644 --- a/R/infinitylists-package.R +++ b/R/infinitylists-package.R @@ -57,6 +57,9 @@ utils::globalVariables( "str_detect", "voucher_location", "voucher_type", - "write.csv" + "write.csv", + "Link", + "Repository", + "Establishment means" ) ) \ No newline at end of file diff --git a/R/server.R b/R/server.R index 7f2ec68..ddbc6a0 100644 --- a/R/server.R +++ b/R/server.R @@ -150,7 +150,7 @@ infinity_server <- function(...) { total_family <- length(unique(data$Family)) native <- - dplyr::filter(data, native_anywhere_in_aus == "native") + dplyr::filter(data, `Establishment means` == "native") if (nrow(native) > 0) total_native_species <- length(unique(native$Species)) else @@ -242,7 +242,7 @@ infinity_server <- function(...) { N = integer(0), Long = numeric(0), Lat = numeric(0), - `Voucher location` = character(0), + `Repository` = character(0), `Recorded by` = character(0), Native = character(0) ) @@ -266,28 +266,27 @@ infinity_server <- function(...) { }, Lat = Lat[1], Long = Long[1], - `Repository` = ifelse( - grepl("https", `Voucher Location`[1]), + Repository = ifelse( + grepl("https", Repository[1]), paste0( "", "iNat", "" ), paste0( "", - `Voucher Location`[1], + Repository[1], "" ) ), `Recorded by` = `Recorded by`[1] ), by = .(Species, - `Establishment means` = native_anywhere_in_aus, + `Establishment means`, `Voucher type` = `Voucher Type`)] @@ -354,25 +353,12 @@ infinity_server <- function(...) { }, content = function(file) { data <- intersect_data() - data$`Voucher Location` = ifelse( - grepl("https", data$`Voucher Location`), - data$`Voucher Location` - , - paste0( - "https://biocache.ala.org.au/occurrences/", - data$`Record Id` - ) - ) - data <- - dplyr::rename(data, - 'Establishment means' = native_anywhere_in_aus, - 'Repository' = `Voucher Location`) + # Fixing the date collectionDate_partial = lubridate::ymd_hms(data$`Collection Date`, tz = "UTC", quiet = TRUE) collectionDate_all = dplyr::if_else( is.na(collectionDate_partial), lubridate::ymd(data$`Collection Date`, tz = "UTC", quiet = TRUE), - collectionDate_partial - ) + collectionDate_partial) data$`Collection Date` <- paste( lubridate::year(collectionDate_all), diff --git a/tests/testthat/_snaps/galah_download.md b/tests/testthat/_snaps/galah_download.md index ead95fe..b23c5c4 100644 --- a/tests/testthat/_snaps/galah_download.md +++ b/tests/testthat/_snaps/galah_download.md @@ -3,16 +3,16 @@ Code odonata Output - # A tibble: 7 x 11 - Species Genus Family `Collection Date` Lat Long `Voucher Type` - - 1 Adversaeschna bre~ Adve~ Aeshn~ 1924-10-01 00:00:00 -33.9 151. Collection - 2 Diplacodes bipunc~ Dipl~ Libel~ 1924-02-23 00:00:00 -37.8 145. Collection - 3 Austrolestes leda Aust~ Lesti~ 1924-11-06 00:00:00 -28.7 152. Collection - 4 Synthemis tasmani~ Synt~ Synth~ 1924-01-01 00:00:00 -41.9 145. Collection - 5 Austroaeschna par~ Aust~ Telep~ 1924-02-01 00:00:00 -42.1 145. Collection - 6 Hemicordulia tau Hemi~ Cordu~ 1924-10-10 00:00:00 -28.7 152. Collection - 7 Synthemis tasmani~ Synt~ Synth~ 1924-01-01 00:00:00 -41.9 145. Collection - # i 4 more variables: `Voucher Location` , `Recorded by` , - # `Record Id` , native_anywhere_in_aus + # A tibble: 7 x 12 + Species Genus Family `Collection Date` Lat Long `Voucher Type` Repository + + 1 Advers~ Adve~ Aeshn~ 1924-10-01 00:00:00 -33.9 151. Collection AM + 2 Diplac~ Dipl~ Libel~ 1924-02-23 00:00:00 -37.8 145. Collection NMV + 3 Austro~ Aust~ Lesti~ 1924-11-06 00:00:00 -28.7 152. Collection QM + 4 Synthe~ Synt~ Synth~ 1924-01-01 00:00:00 -41.9 145. Collection QM + 5 Austro~ Aust~ Aeshn~ 1924-02-01 00:00:00 -42.1 145. Collection QM + 6 Hemico~ Hemi~ Cordu~ 1924-10-10 00:00:00 -28.7 152. Collection QM + 7 Synthe~ Synt~ Synth~ 1924-01-01 00:00:00 -41.9 145. Collection QM + # i 4 more variables: `Recorded by` , `Record Id` , Link , + # `Establishment means`