Merge pull request #102 from atorus-research/101-add-get_key-function

Closes #101 add get keys function

DESCRIPTION

@@ -21,6 +21,10 @@ Authors@R:
              role = "aut",
              email = "[email protected]",
              comment = c(ORCID = "0000-0001-6030-723X")),
+      person(given = "Tamara",
+             family = "Senior",
+             role = "aut",
+             email = "[email protected]"),
       person(given = "GSK/Atorus JPT",
              role = c("cph", "fnd")))
 Description: Create an immutable container holding metadata for the purpose of better enabling programming activities and functionality of other packages within the clinical programming workflow.

NAMESPACE

@@ -7,6 +7,7 @@ export(check_inconsistent_types)
 export(create_tbl)
 export(define_to_metacore)
 export(get_control_term)
+export(get_keys)
 export(is_metacore)
 export(load_metacore)
 export(metacore)

NEWS.md

@@ -1,4 +1,7 @@
-# Metacroe 0.1.2
+# Metacore 0.1.3
+- Add `get_keys` function which returns the dataset keys for a given dataset
+
+# Metacore 0.1.2
 - Update to resolve issues from the dplyr updates
 
 # Metacore 0.1.1

R/metacore.R

@@ -413,6 +413,43 @@ get_control_term <- function(metacode, variable, dataset = NULL){
 }
 
 
+#' Get Dataset Keys
+#'
+#' Returns the dataset keys for a given dataset
+#'
+#' @param metacode metacore object
+#' @param dataset A dataset name
+#'
+#' @return a 2-column tibble with dataset key variables and key sequence
+#' @export
+#'
+#' @importFrom rlang as_label enexpr as_name
+#'
+#' @examples
+#' \dontrun{
+#' meta_ex <- spec_to_metacore(metacore_example("p21_mock.xlsx"))
+#' get_keys(meta_ex, "AE")
+#' get_keys(meta_ex, AE)
+#' }
+get_keys <- function(metacode, dataset){
+   dataset_val <- ifelse(str_detect(as_label(enexpr(dataset)), "\""),
+                         as_name(dataset), as_label(enexpr(dataset))) # to make the filter more explicit
+
+   subset_data <- metacode$ds_vars %>%
+      filter(dataset == dataset_val)
+   if(nrow(subset_data) == 0){
+      stop(paste0(dataset_val, " not found in the ds_vars table. Please check the dataset name"))
+   }
+
+   keys <- subset_data %>%
+      filter(!is.na(key_seq)) %>%
+      select(variable, key_seq)
+
+   keys <- keys[order(keys$key_seq),]
+
+   return(keys)
+}
+
 
 #' save metacore object
 #'

tests/testthat/test-metacore.R

@@ -137,3 +137,18 @@ test_that("pulling out control terminology works", {
    )
    })
 
+test_that("get_keys works", {
+   test <- spec_to_metacore(metacore_example("p21_mock.xlsx"), quiet = TRUE)
+   #Testing Errors
+   ## Domain not in ds_vars table
+   expect_error(get_keys(test, DS))
+   ## Missing dataset name
+   expect_error(get_keys(test))
+   #Testing Correct Output
+   expect_equal(
+      get_keys(test, DM),
+      tibble(variable = c("STUDYID", "USUBJID"), key_seq = c(1L, 2L)) %>%
+         add_labs(variable = "Variable Name",
+                  key_seq = "Sequence Key")
+   )
+})