Merge pull request #10 from ocean-tracking-network/worms_query

Adds the functions to handle accessing and creation of the worms aphiaID column.

DESCRIPTION

@@ -14,7 +14,7 @@ Description: Surimi takes as input data files representing acoustic telemetry, w
 License: GPL (>= 3)
 Encoding: UTF-8
 Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.2.3
+RoxygenNote: 7.3.1.9000
 Imports: 
     dplyr,
     lubridate,

NAMESPACE

@@ -18,3 +18,4 @@ importFrom(lubridate,as_date)
 importFrom(lubridate,ymd)
 importFrom(tidyr,separate)
 importFrom(tidyr,unite)
+importFrom(worrms,wm_name2id)

R/get_aphiaIDs.R

@@ -0,0 +1,51 @@
+##' @title Get AphiaIDs for scientific names
+##'
+##' @description Takes a column of scientific names and creates a lookup table (read: named list) of the unique scientific names
+##' against their aphia IDs. We can use worrms to query the WORMS REST service for the aphiaIDs, but doing it for every row is
+##' time intensive in a way we don't want. This way, we can create the lookup client-side and then do all the querying only as
+##' we need to.
+##'
+##' @param scinames A vector (dataframe column) containing the list of scientific names from a detection extract dataframe in
+##' Surimi.
+##'
+##' @importFrom worrms wm_name2id
+##'
+##' @return Returns a named list with the scientific name as the key and the aphiaID as the value.
+##'
+
+# get a table of unique scientific names and aphiaIDs.
+get_unique_aphiaids <- function(scinames) {
+  # Get the unique names.
+  unique_names <- unique(scinames)
+
+  # Create an empty list to hold our name/value pairs.
+  aphia_ids <- list()
+
+  # Build the dict
+  for (name in unique_names) {
+    # wm_name2id is a worrms function for associating a scientific name with its Aphia ID.
+    aphia_ids[[name]] <- worrms::wm_name2id(name)
+  }
+
+  # return the table.
+  return(aphia_ids)
+}
+
+
+##' @title Consult a lookup table for the aphiaID.
+##'
+##' @description This is the helper function that we use in the sapply when mutating the WORMS_species_aphia_id into existence.
+##'
+##' @param sciname A Scientific name as a string.
+##' @param lookup The named list containing key-value pairs of scientific names and aphiaIDs.
+##'
+##' @return Returns the appropriate aphiaID corresponding to the sciname.
+##'
+
+get_aphiaid_from_lookup <- function(sciname, lookup) {
+  # Get the aphiaID from the lookup table.
+  aphiaid <- lookup[[sciname]]
+  # Strip off the 'named' part (this is what isn't working)
+  # aphiaid <- as.character(unname(aphiaid))
+  return(aphiaid)
+}

R/otn_imos_column_map.R

@@ -57,6 +57,9 @@ otn_imos_column_map <- function(det_dataframe, rcvr_dataframe = NULL, tag_datafr
     tag_return <- derive_tag_from_det(det_dataframe)
   }
 
+  # Construct a little lookup table for the aphiaIDs. This keeps us from having to query the WORMS database over and over again (for example, the data I tested on had 300 entries for 'blue shark')- lot of redundant querying there.
+  lookup <- get_unique_aphiaids(det_dataframe$scientificname)
+
   # Start by mapping the Detections dataframe.
   det_return <- det_dataframe %>%
     select(
@@ -82,7 +85,7 @@ otn_imos_column_map <- function(det_dataframe, rcvr_dataframe = NULL, tag_datafr
     mutate(
       cleandate = ymd(as_date(datecollected)),
       CAAB_species_id = NA,
-      WORMS_species_aphia_id = NA,
+      WORMS_species_aphia_id = sapply(det_dataframe$scientificname, USE.NAMES = FALSE, FUN = get_aphiaid_from_lookup, lookup = lookup),
       animal_sex = NA,
       receiver_name = NA,
       receiver_project_name = NA,