Merge pull request #12 from mhpob/split-qmd-tag

Break template into self-contained functions

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: otndo
 Title: Understand your OTN data
-Version: 0.1.10
+Version: 0.2.0
 Authors@R: 
     person("Michael", "O'Brien", , "[email protected]", role = c("aut", "cre"),
            comment = c(ORCID = "0000-0003-1420-6395"))

NAMESPACE

@@ -1,20 +1,24 @@
 # Generated by roxygen2: do not edit by hand
 
+export(deployment_gantt)
 export(make_receiver_push_summary)
 export(make_tag_push_summary)
+export(match_map)
+export(match_table)
+export(matched_abacus)
+export(otn_query)
+export(prep_station_spatial)
+export(project_contacts)
+export(remaining_transmitters)
+export(station_table)
+export(temporal_distribution)
 importFrom(data.table,":=")
-importFrom(data.table,.BY)
-importFrom(data.table,.EACHI)
-importFrom(data.table,.GRP)
-importFrom(data.table,.I)
 importFrom(data.table,.N)
-importFrom(data.table,.NGRP)
-importFrom(data.table,.SD)
-importFrom(data.table,data.table)
 importFrom(ggplot2,ggplot)
 importFrom(mapview,mapview)
 importFrom(reactable,reactable)
 importFrom(sf,read_sf)
+importFrom(stats,median)
 importFrom(utils,URLencode)
 importFrom(utils,read.csv)
 importFrom(utils,unzip)

NEWS.md

@@ -1,12 +1,17 @@
-# otndo 0.1.02
+## otndo 0.2
+### v 0.2.0
 
-* Fix issue where otndo would get lost when deployment metadata sheet wasn't labeled
+* Break out all of the functions internal to the QMD template. Will allow for clearer errors and more-directed testing.
 
-# otndo 0.1.0
+## otndo 0.1
 
+* Fix issue where otndo would get lost when deployment metadata sheet wasn't labeled
 * Switch to semantic versioning
 * Add figure and table captions
+* Runiverse!
+* Miscellaneous fixes
+* Combine the PIs/POCs of projects with changing staff
 
-# otndo 0.0.0.9000
+## otndo 0.0.0.9000
 
 * Added a `NEWS.md` file to track changes to the package.

R/deployment_gantt.R

@@ -0,0 +1,61 @@
+#' Create a Gantt-like chart of receiver deployments and recoveries
+#'
+#' @param deployment Cleaned deployment metadata sheet(s). Assumes it was
+#'    cleaned with the internal `otndo:::clean_otn_deployment` function, read in,
+#'    and converted to a data.table.
+#'
+#' @examples
+#' \dontrun{
+#' # Download a deployment metadata file
+#' td <- file.path(tempdir(), "matos_test_files")
+#' dir.create(td)
+#'
+#' download.file(
+#'   paste0(
+#'     "https://members.oceantrack.org/data/repository/pbsm/",
+#'     "data-and-metadata/2018/pbsm-instrument-deployment-short-form-2018.xls/",
+#'     "@@download/file"
+#'   ),
+#'   destfile = file.path(td, "pbsm-instrument-deployment-short-form-2018.xls"),
+#'   mode = "wb"
+#' )
+#'
+#' # Use internal function to clean
+#' deployment_filepath <- otndo:::write_to_tempdir(
+#'   type = "deployment",
+#'   files = file.path(td, "pbsm-instrument-deployment-short-form-2018.xls"),
+#'   temp_dir = td
+#' )
+#'
+#' # Make the Gantt chart
+#' deployment_gantt(
+#'   data.table::fread(deployment_filepath)
+#' )
+#' }
+#'
+#' @export
+deployment_gantt <- function(deployment) {
+  stationname <- deploy_date_time <- recover_date_time <- NULL
+
+  ggplot2::ggplot(data = deployment) +
+    ggplot2::geom_linerange(
+      ggplot2::aes(
+        y = stationname,
+        xmin = deploy_date_time,
+        xmax = recover_date_time
+      ),
+      linewidth = 5
+    ) +
+    ggplot2::geom_linerange(
+      ggplot2::aes(
+        ymin = as.numeric(factor(stationname)) - 0.4,
+        ymax = as.numeric(factor(stationname)) + 0.4,
+        x = recover_date_time
+      ),
+      color = "red", linewidth = 2
+    ) +
+    ggplot2::scale_x_datetime(date_breaks = "month", date_labels = "%b %y") +
+    ggplot2::labs(x = NULL, y = NULL, title = "Temporal receiver coverage") +
+    ggplot2::theme_minimal() +
+    ggplot2::theme(axis.text.x = ggplot2::element_text(angle = 45, hjust = 1))
+}

R/make_receiver_push_summary.R

@@ -29,7 +29,8 @@
 #' download.file(
 #'   paste0(
 #'     "https://members.oceantrack.org/data/repository/pbsm/",
-#'     "data-and-metadata/2018/pbsm-instrument-deployment-short-form-2018.xls"
+#'     "data-and-metadata/2018/pbsm-instrument-deployment-short-form-2018.xls/",
+#'     "@@download/file"
 #'   ),
 #'   destfile = file.path(td, "pbsm-instrument-deployment-short-form-2018.xls"),
 #'   mode = "wb"
@@ -39,9 +40,11 @@
 #' download.file(
 #'   paste0(
 #'     "https://members.oceantrack.org/data/repository/pbsm/",
-#'     "detection-extracts/pbsm_qualified_detections_2018.zip"
+#'     "detection-extracts/pbsm_qualified_detections_2018.zip/",
+#'     "@@download/file"
 #'   ),
-#'   destfile = file.path(td, "pbsm_qualified_detections_2018.zip")
+#'   destfile = file.path(td, "pbsm_qualified_detections_2018.zip"),
+#'   mode = "wb"
 #' )
 #' unzip(
 #'   file.path(td, "pbsm_qualified_detections_2018.zip"),
@@ -51,9 +54,11 @@
 #' download.file(
 #'   paste0(
 #'     "https://members.oceantrack.org/data/repository/pbsm/",
-#'     "detection-extracts/pbsm_unqualified_detections_2018.zip"
+#'     "detection-extracts/pbsm_unqualified_detections_2018.zip/",
+#'     "@@download/file"
 #'   ),
-#'   destfile = file.path(td, "pbsm_unqualified_detections_2018.zip")
+#'   destfile = file.path(td, "pbsm_unqualified_detections_2018.zip"),
+#'   mode = "wb"
 #' )
 #' unzip(
 #'   file.path(td, "pbsm_unqualified_detections_2018.zip"),

R/make_tag_push_summary.R

@@ -17,9 +17,11 @@
 #' download.file(
 #'   paste0(
 #'     "https://members.oceantrack.org/data/repository/",
-#'     "pbsm/detection-extracts/pbsm_matched_detections_2018.zip"
+#'     "pbsm/detection-extracts/pbsm_matched_detections_2018.zip/",
+#'     "@download/file"
 #'   ),
-#'   destfile = file.path(td, "pbsm_matched_detections_2018.zip")
+#'   destfile = file.path(td, "pbsm_matched_detections_2018.zip"),
+#'   mode = "wb"
 #' )
 #' unzip(file.path(td, "pbsm_matched_detections_2018.zip"),
 #'   exdir = td
@@ -38,7 +40,7 @@
 #' }
 make_tag_push_summary <- function(
     matched = NULL,
-    update_push_log = F,
+    update_push_log = FALSE,
     since = NULL,
     sensor_decoding = NULL,
     out_dir = getwd(),

R/match_map.R

@@ -0,0 +1,34 @@
+#' Plot the geographic extent of OTN projects
+#'
+#' @param otn_tables A list containing OTN's `otn_resources_metadata_points`
+#'    GeoServer layer. Usually created using `otn_query`.
+#'
+#' @examples
+#' match_map(
+#'   otn_query("MDWEA")
+#' )
+#'
+#' @export
+
+match_map <- function(otn_tables) {
+  natural_earth <- sf::st_read(
+    system.file("ne_110m_coastline.gpkg",
+      package = "otndo"
+    ),
+    quiet = T
+  )
+
+  otn_sf <- otn_tables$otn_resources_metadata_points |>
+    sf::st_as_sf(wkt = "the_geom", crs = 4326)
+  otn_limits <- sf::st_bbox(otn_sf)
+
+  ggplot2::ggplot() +
+    ggplot2::geom_sf(data = natural_earth) +
+    ggplot2::geom_sf(data = otn_sf, fill = NA, color = "blue") +
+    ggplot2::coord_sf(
+      xlim = c(otn_limits["xmin"] - 5, otn_limits["xmax"] + 5),
+      ylim = c(otn_limits["ymin"] - 5, otn_limits["ymax"] + 5)
+    ) +
+    ggplot2::labs(title = "Geographic extent of detected projects") +
+    ggplot2::theme_minimal()
+}

R/match_table.R

@@ -0,0 +1,169 @@
+#' Create a reactable table of matched detections
+#'
+#' @param extract matched (transmitter) or qualified (receiver) OTN detections
+#' @param type Tag or receiver data? Takes values of "tag" and "receiver";
+#'    defaults to "tag".
+#'
+#' @examples
+#' \dontrun{
+#' # Receiver
+#' download.file(
+#'   paste0(
+#'     "https://members.oceantrack.org/data/repository/pbsm/",
+#'     "detection-extracts/pbsm_qualified_detections_2018.zip/",
+#'     "@@download/file"
+#'   ),
+#'   destfile = file.path(td, "pbsm_qualified_detections_2018.zip"),
+#'   mode = "wb"
+#' )
+#' unzip(
+#'   file.path(td, "pbsm_qualified_detections_2018.zip"),
+#'   exdir = td
+#' )
+#'
+#' qualified_dets <- data.table::fread(
+#'   file.path(td, "pbsm_qualified_detections_2018.csv")
+#' )
+#'
+#' match_table(
+#'   extract = qualified_dets,
+#'   type = "receiver"
+#' )
+#'
+#' # Transmitters
+#' download.file(
+#'   paste0(
+#'     "https://members.oceantrack.org/data/repository/",
+#'     "pbsm/detection-extracts/pbsm_matched_detections_2018.zip/",
+#'     "@@download/file"
+#'   ),
+#'   destfile = file.path(td, "pbsm_matched_detections_2018.zip"),
+#'   mode = "wb"
+#' )
+#' unzip(file.path(td, "pbsm_matched_detections_2018.zip"),
+#'   exdir = td
+#' )
+#'
+#' matched_dets <- data.table::fread(
+#'   file.path(td, "pbsm_matched_detections_2018.csv")
+#' )
+#'
+#' match_table(
+#'   extract = matched_dets,
+#'   type = "tag"
+#' )
+#' }
+#'
+#' @export
+match_table <- function(
+    extract,
+    type = c("tag", "receiver")) {
+  mt_data <- prep_match_table(extract, type)
+
+  reactable::reactable(
+    mt_data,
+    columns = list(
+      PI = reactable::colDef(
+        html = T,
+        cell = function(value, index) {
+          sprintf(
+            '<a href=mailto:%s target="_blank">%s</a>',
+            mt_data$PI_emails[index], value
+          )
+        },
+        minWidth = 150
+      ),
+      POC = reactable::colDef(
+        html = T,
+        cell = function(value, index) {
+          sprintf(
+            '<a href=mailto:%s target="_blank">%s</a>',
+            mt_data$POC_emails[index], value
+          )
+        },
+        minWidth = 150
+      ),
+      PI_emails = reactable::colDef(show = F),
+      POC_emails = reactable::colDef(show = F),
+      `Project name` = reactable::colDef(minWidth = 200)
+    )
+  )
+}
+
+
+#' Prepare the detection match summary data
+#'
+#' @inheritParams match_table
+prep_match_table <- function(
+    extract,
+    type = c("tag", "receiver")) {
+  . <- collectioncode <- project_name <- resource_full_name <- PI <- POC <-
+    network <- code <- detections <- individuals <- PI_emails <- POC_emails <-
+    station <- Station <- Detections <- Individuals <- longitude <- latitude <-
+    detectedby <- NULL
+
+  extract <- data.table::data.table(extract)
+
+  if (type == "tag") {
+    mt <- merge(
+      extract[, .(detections = .N), by = "detectedby"],
+      unique(extract, by = c("tagname", "detectedby"))[
+        , .(individuals = .N),
+        by = "detectedby"
+      ]
+    )
+
+    data.table::setnames(mt, "detectedby", "project_name")
+
+    otn <- otn_query(unique(extract$detectedby))
+  } else {
+    mt <- merge(
+      extract[, .(detections = .N), by = "trackercode"],
+      unique(extract, by = "fieldnumber")[, .(individuals = .N),
+        by = "trackercode"
+      ]
+    )
+
+    data.table::setnames(mt, "trackercode", "project_name")
+
+    otn <- otn_query(unique(extract$trackercode))
+  }
+
+  pis <- project_contacts(extract, type = type)
+  mt <- merge(mt, pis)
+
+  mt[, collectioncode := gsub(".*\\.", "", project_name)]
+
+  mt <- merge(
+    mt,
+    otn[[1]][
+      ,
+      .(
+        resource_full_name,
+        collectioncode
+      )
+    ],
+    by = "collectioncode"
+  )
+
+
+  mt[, ":="(network = gsub("\\..*", "", project_name),
+    code = gsub(".*\\.", "", project_name),
+    project_name = NULL,
+    PI = data.table::fifelse(PI == "NA", "", PI),
+    POC = data.table::fifelse(POC == "NA", "", POC))]
+  mt[, network := data.table::fifelse(network == code, "", network)]
+
+  mt <- mt[, .(
+    PI, POC, resource_full_name, network, code,
+    detections, individuals, PI_emails, POC_emails
+  )]
+  data.table::setnames(mt, c(
+    "PI", "POC", "Project name", "Network", "Project code",
+    "Detections", "Individuals", "PI_emails", "POC_emails"
+  ))
+
+  data.table::setorder(mt, -"Detections", -"Individuals")
+
+  mt[]
+}