Merge pull request #10 from FredHutch/getIDs

add copyAnnotations and getTGRid

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: tgR
 Type: Package
 Title: TGR Convenience Functions
-Version: 0.3.1
+Version: 0.3.3
 Author: Amy Paguirigan
 Maintainer: Amy Paguirigan <[email protected]>
 Description: This package provides helper functions needed to coordinate between various aspects of repository.
@@ -18,7 +18,8 @@ Imports:
     dplyr,
     purrr,
     RCurl,
-    checkmate
+    checkmate,
+    stringr
 Encoding: UTF-8
 LazyData: true
 RoxygenNote: 6.1.1

NAMESPACE

@@ -1,6 +1,7 @@
 # Generated by roxygen2: do not edit by hand
 
 export("%>%")
+export(copyAnnotations)
 export(cromwellAbort)
 export(cromwellCache)
 export(cromwellCall)
@@ -13,6 +14,7 @@ export(cromwellSubmitBatch)
 export(cromwellWorkflow)
 export(dropWhen)
 export(getDictionary)
+export(getTGRid)
 export(listS3Objects)
 export(prep_s3_copy_and_tag)
 export(s3_copy_and_tag)

R/copyAnnotations.R

@@ -0,0 +1,57 @@
+#' Copy annotations from another record
+#' @description Copies the study, specimen and assay material metadata from another record in the Repository
+#' @param copyFrom The molecular_id of the record to copy data from
+#' @param copyTo The molecular_id of the record to edit using copied data
+#' @param type A character array of the types of annotations you want to copy: "submission", "study", "subject", "biospecimen", "assaymaterial", "genomics". Default: c("submission", "study")
+#' @param overwriteExisting Default to false.  If data exists in the record to edit, do you want to overwrite existing data?
+#' @return Results of the copy attempt including the data of the new record as well as the REDCap response.
+#' @author Amy Paguirigan
+#' @details Requires valid credentials to be set in the environment with setCreds() and to have write priviledges to the data
+#' @export
+copyAnnotations <- function(copyFrom = NULL, copyTo = NULL, type = c("submission", "study"), overwriteExisting = FALSE) {
+  if ("" %in% Sys.getenv(c("REDURI", "S3A", "S3SA", "TGR"))) {
+    stop("You have missing environment variables.  Please set creds in env vars.")}
+  else message("Credentials set successfully.")
+
+  if (is.null(copyFrom) == TRUE | is.null(copyTo) == TRUE) {
+    stop("Please specify both the molecular_id of the record to copy from (copyFrom) and that for the record to edit (copyTo).")
+  } else if (sum(!type %in% c("submission", "study", "subject", "biospecimen", "assaymaterial", "genomics")) > 0) {
+    message('Please choose one or more of these values: "submission", "study", "subject", "biospecimen", "assaymaterial", "genomics".')
+  } else {
+    dictionary <- suppressMessages(
+      REDCapR::redcap_metadata_read(Sys.getenv("REDURI"), Sys.getenv("TGR"))$data)
+    type <- c("id", type)
+    onlyThese <- dictionary[dictionary$field_annotation %in% type,]
+    sourceRecord <- suppressMessages(REDCapR::redcap_read_oneshot(
+      Sys.getenv("REDURI"), Sys.getenv("TGR"), records = copyFrom,
+      fields = paste0(onlyThese$field_name, collapse = "',"),
+      export_data_access_groups = TRUE, guess_type = F)$data)
+    ## Test to make sure these molecular_ids are valid and the user has access to them
+    if (nrow(sourceRecord) != 1) {
+      stop("Please enter a valid molecular_id to copy from.")
+    } else {
+      destinationRecord <- suppressMessages(REDCapR::redcap_read_oneshot(
+        Sys.getenv("REDURI"), Sys.getenv("TGR"), records = copyTo,
+        fields = paste0(onlyThese$field_name, collapse = "',"),
+        export_data_access_groups = TRUE, guess_type = F)$data)
+      # only keep fields with values in them in destination record
+      destinationRecord <- destinationRecord[,is.na(destinationRecord)==F]
+      if (nrow(destinationRecord) != 1) {
+        stop("Please enter a valid molecular_id to copy to.")
+      }
+    }
+    if (overwriteExisting == FALSE) {
+      # only source columns that don't already have a value in the destination REcord AND aren't NA
+      onlyNewData <- sourceRecord[,!colnames(sourceRecord) %in% colnames(destinationRecord) & is.na(sourceRecord)==F]
+      updatedRecord <- cbind(destinationRecord, onlyNewData)
+    } else if (overwriteExisting == TRUE) {
+      updatedRecord <- sourceRecord
+      updatedRecord$molecular_id <- destinationRecord$molecular_id
+      updatedRecord$redcap_data_access_group <- destinationRecord$redcap_data_access_group
+    }
+    uploadResponse <- REDCapR::redcap_write_oneshot(updatedRecord, redcap_uri = Sys.getenv("REDURI"), token = Sys.getenv("TGR"))
+  }
+  return(list(data = updatedRecord, redcap_result = uploadResponse))
+  }
+
+

R/dropWhen.R

@@ -8,7 +8,9 @@
 #' @return Returns a columnn filtered data frame.  Note, does not take into account numeric, integer or character value differences (it will treat them all the same).
 #' @author Amy Paguirigan
 #' @examples
-#' df <- data.frame(this = c(NA, seq(1, 5, 1), seq(1, 5, 1)), that = rep(0, 11), thisotherThing = rep(NA), ohAndThis = rep(c("trash", "0"), 11))
+#' df <- data.frame(this = c(NA, seq(1, 5, 1), seq(1, 5, 1)), that = rep(0, 11),
+#' thisotherThing = rep(NA),
+#' ohAndThis = rep(c("trash", "0"), 11))
 #' cleanerdf <- dropWhen(df, unique = FALSE, trash = c("0", "trash"), requireAll = FALSE)
 #' @export
 dropWhen <- function(df, unique = FALSE, trash=NULL, requireAll = TRUE, except = NULL) {

R/getTGRid.R

@@ -0,0 +1,35 @@
+#' Request next subsequent molecular id in the TGR
+#' @description Requests and initializes a new record in REDCap in the specified Data Access Group (DAG)
+#' @param DAG Data access group to assign the new record to.
+#' @return An empty data frame with the new identifier and it's data access group, ready for additions and upload to REDCap.  Also initializes the record in REDCap.
+#' @author Amy Paguirigan
+#' @details Requires valid admin credentials to be set in the environment with setCreds()
+#' @export
+getTGRid <- function(DAG = NULL) {
+    if ("" %in% Sys.getenv(c("REDURI", "S3A", "S3SA", "TGR"))) {
+        stop("You have missing environment variables.  Please set creds in env vars.")}
+    else message("Credentials set successfully.")
+
+    if (is.null(DAG) == TRUE) {
+       stop("Please specify a valid Data Access Group (DAG) for this record.")
+        } else {
+         usedIDs <- suppressMessages(REDCapR::redcap_read_oneshot(
+            Sys.getenv("REDURI"), Sys.getenv("TGR"), fields = "molecular_id",
+            export_data_access_groups = TRUE, guess_type = F)$data)
+         if (DAG %in% usedIDs$redcap_data_access_group == F) {
+             stop("This DAG is invalid.")
+             return()
+         } else {
+             sorted <- dplyr::arrange(usedIDs, molecular_id)
+             numerics <- as.numeric(gsub("M", "", sorted$molecular_id))
+             nextRecord <- max(numerics)+1
+             newID <- paste0("M", stringr::str_pad(nextRecord, 8, pad = "0"))
+
+             message(paste0("New ID is: ", newID))
+             stub <- data.frame("molecular_id" = newID, "redcap_data_access_group" = DAG)
+             initializeResults <- REDCapR::redcap_write_oneshot(stub, redcap_uri = Sys.getenv("REDURI"), token = Sys.getenv("TGR"))
+             return(list("dataframe" = stub, "initializeResults" = initializeResults))
+         }
+    }
+}
+