Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Moved URL creation from server to galah_download #89

Merged
merged 6 commits into from
Mar 1, 2024
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
15 changes: 10 additions & 5 deletions R/galah_download.R
Original file line number Diff line number Diff line change
Expand Up @@ -166,21 +166,20 @@
get_establishment_status <- function(ala_cleaned, taxon = taxon) {
if (taxon == "Plantae") {
resources <- APCalign::load_taxonomic_resources()
suppressWarnings(

Check warning on line 169 in R/galah_download.R

View check run for this annotation

Codecov / codecov/patch

R/galah_download.R#L169

Added line #L169 was not covered by tests
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",
Expand All @@ -189,6 +188,9 @@
"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)
}

Expand All @@ -211,7 +213,7 @@
!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",
Expand All @@ -232,10 +234,13 @@
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")
}

Expand Down
5 changes: 4 additions & 1 deletion R/infinitylists-package.R
Original file line number Diff line number Diff line change
Expand Up @@ -57,6 +57,9 @@ utils::globalVariables(
"str_detect",
"voucher_location",
"voucher_type",
"write.csv"
"write.csv",
"Link",
"Repository",
"Establishment means"
)
)
34 changes: 10 additions & 24 deletions R/server.R
Original file line number Diff line number Diff line change
Expand Up @@ -150,7 +150,7 @@
total_family <- length(unique(data$Family))

native <-
dplyr::filter(data, native_anywhere_in_aus == "native")
dplyr::filter(data, `Establishment means` == "native")

Check warning on line 153 in R/server.R

View check run for this annotation

Codecov / codecov/patch

R/server.R#L153

Added line #L153 was not covered by tests
if (nrow(native) > 0)
total_native_species <- length(unique(native$Species))
else
Expand Down Expand Up @@ -242,7 +242,7 @@
N = integer(0),
Long = numeric(0),
Lat = numeric(0),
`Voucher location` = character(0),
`Repository` = character(0),

Check warning on line 245 in R/server.R

View check run for this annotation

Codecov / codecov/patch

R/server.R#L245

Added line #L245 was not covered by tests
`Recorded by` = character(0),
Native = character(0)
)
Expand All @@ -266,28 +266,27 @@
},
Lat = Lat[1],
Long = Long[1],
`Repository` = ifelse(
grepl("https", `Voucher Location`[1]),
Repository = ifelse(
grepl("https", Repository[1]),

Check warning on line 270 in R/server.R

View check run for this annotation

Codecov / codecov/patch

R/server.R#L269-L270

Added lines #L269 - L270 were not covered by tests
paste0(
"<a href='",
`Voucher Location`[1],
Link[1],

Check warning on line 273 in R/server.R

View check run for this annotation

Codecov / codecov/patch

R/server.R#L273

Added line #L273 was not covered by tests
"' target='_blank'>",
"iNat",
"</a>"
),
paste0(
"<a href='",
"https://biocache.ala.org.au/occurrences/",
`Record Id`[1],
Link[1],

Check warning on line 280 in R/server.R

View check run for this annotation

Codecov / codecov/patch

R/server.R#L280

Added line #L280 was not covered by tests
"' target='_blank'>",
`Voucher Location`[1],
Repository[1],

Check warning on line 282 in R/server.R

View check run for this annotation

Codecov / codecov/patch

R/server.R#L282

Added line #L282 was not covered by tests
"</a>"
)
),
`Recorded by` = `Recorded by`[1]
),
by = .(Species,
`Establishment means` = native_anywhere_in_aus,
`Establishment means`,

Check warning on line 289 in R/server.R

View check run for this annotation

Codecov / codecov/patch

R/server.R#L289

Added line #L289 was not covered by tests
`Voucher type` = `Voucher Type`)]


Expand Down Expand Up @@ -354,25 +353,12 @@
},
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)

Check warning on line 361 in R/server.R

View check run for this annotation

Codecov / codecov/patch

R/server.R#L361

Added line #L361 was not covered by tests
data$`Collection Date` <-
paste(
lubridate::year(collectionDate_all),
Expand Down
24 changes: 12 additions & 12 deletions tests/testthat/_snaps/galah_download.md
Original file line number Diff line number Diff line change
Expand Up @@ -3,16 +3,16 @@
Code
odonata
Output
# A tibble: 7 x 11
Species Genus Family `Collection Date` Lat Long `Voucher Type`
<chr> <chr> <chr> <dttm> <dbl> <dbl> <chr>
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` <chr>, `Recorded by` <chr>,
# `Record Id` <chr>, native_anywhere_in_aus <chr>
# A tibble: 7 x 12
Species Genus Family `Collection Date` Lat Long `Voucher Type` Repository
<chr> <chr> <chr> <dttm> <dbl> <dbl> <chr> <chr>
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` <chr>, `Record Id` <chr>, Link <chr>,
# `Establishment means` <chr>

Loading