Merge pull request #122 from pbchase/update_write_summary_metrics

Update write summary metrics, add a function and two data objects

DESCRIPTION

@@ -59,6 +59,7 @@ Imports:
 Suggests:
     RSQLite,
     digest,
+    duckdb,
     fs,
     knitr (>= 1.18),
     rmarkdown (>= 2.0),

NAMESPACE

@@ -4,6 +4,7 @@ export(connect_to_db)
 export(connect_to_log_db)
 export(connect_to_redcap_db)
 export(convert_schema_to_sqlite)
+export(copy_entire_table_to_db)
 export(create_allocation_rows)
 export(create_randomization_row)
 export(create_test_table)

R/data.R

@@ -94,6 +94,28 @@
 #' @title project_life_cycle_descriptions
 #' @description A character vector of the descriptions used in the redcap_log_event table
 #'   to describe the different stages in the life cycle of a REDCap Project
-#' @format A charecter vector with 24 elements
+#' @format A character vector with 24 elements
 #' @details DETAILS
 "project_life_cycle_descriptions"
+
+#' @title project_status_labels
+#' @description A tibble project status IDs and project statuses that reflect their
+#'   meaning as used in the `status` column of the `redcap_projects` table
+#' @format A data frame with 4 rows and 2 variables:
+#' \describe{
+#'   \item{\code{id}}{double primary key}
+#'   \item{\code{project_status}}{character redcap project status}
+#'}
+#' @details DETAILS
+"project_status_labels"
+
+#' @title project_purpose_labels
+#' @description A tibble project purpose IDs and project purposes that reflect their
+#'   meaning as used in the `purpose` column of the `redcap_projects` table
+#' @format A data frame with 5 rows and 2 variables:
+#' \describe{
+#'   \item{\code{id}}{double primary key}
+#'   \item{\code{project_purpose}}{character redcap project purpose}
+#'}
+#' @details DETAILS
+"project_purpose_labels"

R/devtools.R

@@ -146,3 +146,98 @@ mutate_columns_to_posixct <- function(data, column_names) {
 
   return(result)
 }
+
+#' @title copy_entire_table_to_db
+#' @description Copy and entire DBI table from one DBI connection to another.
+#'   This is a developer tool designed as an aid to testing and development.
+#'   It designed to be called via \code{purrr::walk2()} to clone sets of tables in
+#'   a data-driven way to an ephemeral database created, generally with Duck
+#'   DB.
+#'
+#'   \strong{Limitations}
+#'
+#'   \itemize{
+#'     \item The table referenced in \code{table_name} must not exist on \code{target_conn}.
+#'     \item This function is suitable for cloning small tables.
+#'     \item When called via \code{purrr::walk2()}, all tables in the vector of
+#'     table names will be copied to the single \code{target_conn} DBI object
+#'     even if the source table is on different \code{source_conn} DBI objects.
+#'   }
+#' @param source_conn - the DBI connection object that holds the source table
+#' @param table_name - the name of the table to be copied
+#' @param target_conn - the DBI connection object to which the table will
+#'   be copied
+#'
+#' @return No result
+#' @export
+#'
+#' @examples
+#' # Build the objects need for testing
+#' test_data <- dplyr::tribble(
+#'   ~a, ~b, ~c, ~d,
+#'   "asdf", 1, TRUE, lubridate::ymd_hms("2023-01-14 12:34:56"),
+#'   "qwer", 2, FALSE, lubridate::ymd_hms("2016-01-14 12:34:56")
+#' )
+#' table_name <- "test_data"
+#' source_conn <- DBI::dbConnect(duckdb::duckdb(), dbdir = ":memory:")
+#' DBI::dbWriteTable(conn = source_conn, name = table_name, value = test_data)
+#'
+#' # copy the table
+#' target_conn <- DBI::dbConnect(duckdb::duckdb(), dbdir = ":memory:")
+#' copy_entire_table_to_db(
+#'   source_conn = source_conn,
+#'   table_name = table_name,
+#'   target_conn = target_conn
+#' )
+#'
+#' dplyr::collect(dplyr::tbl(target_conn, table_name))
+#'
+#' \dontrun{
+#' library(tidyverse)
+#' library(lubridate)
+#' library(dotenv)
+#' library(DBI)
+#' library(RMariaDB)
+#' library(redcapcustodian)
+#'
+#' init_etl("my_script_name")
+#'
+#' rc_conn <- connect_to_redcap_db()
+#' log_conn <- get_package_scope_var("log_con")
+#'
+#' # describe the tables you want to clone
+#' test_tables <- tribble(
+#'   ~conn, ~table,
+#'   rc_conn, "redcap_user_information",
+#'   rc_conn, "redcap_projects",
+#'   log_conn, "redcap_summary_metrics"
+#' )
+#'
+#' # make the target DB and clone the tables
+#' target_conn <- DBI::dbConnect(
+#'   duckdb::duckdb(),
+#'   dbdir = ":memory:"
+#' )
+#' purrr::walk2(
+#'   test_tables$conn,
+#'   test_tables$table,
+#'   copy_table_to_db,
+#'   target_conn
+#' )
+#'
+#' # Enumerate the tables you copied if you like
+#' DBI::dbListTables(target_conn)
+#'
+#' # replace original connection objects
+#' rc_conn <- target_conn
+#' log_conn <- target_conn
+#'
+#' # At this point you can do destructive things on the original
+#' #   connection objects because they point at the ephemeral
+#' #   copies of the tables.
+#' }
+copy_entire_table_to_db <- function(source_conn, table_name, target_conn) {
+  dplyr::tbl(source_conn, table_name) %>%
+    dplyr::collect() %>%
+    DBI::dbWriteTable(conn = target_conn, name = table_name, value = .)
+}

R/summary_metrics.R

@@ -4,6 +4,9 @@
 #' @param reporting_period_end a datetime object, e.g. ymd_hms("2022-12-01 00:00:00")
 #' @param metric_type a character string representing the metric type, e.g. "flux", "state"
 #' @param metric_dataframe A wide data frame of key-value pairs with a single row of data
+#' @param conn A DBI connection object to the database that holds the
+#'        `redcap_summary_metrics` table. Can be left as NULL if the connection is available
+#'        on the package scope var "log_con".
 #'
 #' @return nothing
 #'
@@ -14,13 +17,19 @@
 #'    reporting_period_start = ymd_hms("2022-01-01 00:00:00", tz=Sys.getenv("TIME_ZONE")),
 #'    reporting_period_end = ceiling_date(reporting_period_start, "month", change_on_boundary = T)
 #'    metric_type = "state",
-#'    metric_dataframe = my_cool_df
+#'    metric_dataframe = my_cool_df,
+#'    conn = my_conn
 #'  )
 #' }
 write_summary_metrics <- function(reporting_period_start,
                                   reporting_period_end,
                                   metric_type,
-                                  metric_dataframe) {
+                                  metric_dataframe,
+                                  conn = NULL) {
+
+  if (is.null(conn)) {
+    conn = get_package_scope_var("log_con")
+  }
 
   tall_df <- metric_dataframe %>%
     tidyr::pivot_longer(
@@ -45,8 +54,6 @@ write_summary_metrics <- function(reporting_period_start,
       "script_run_time"
     )
 
-  log_conn <- get_package_scope_var("log_con")
-
   # log data in redcap_summary_metrics
-  DBI::dbAppendTable(log_conn, "redcap_summary_metrics", tall_df)
+  DBI::dbAppendTable(conn, "redcap_summary_metrics", tall_df)
 }

data-raw/redcap_lookup_tables.R

@@ -0,0 +1,20 @@
+project_purpose_labels <- dplyr::tribble(
+  ~id, ~project_purpose,
+  4, "Operational Support",
+  2, "Research",
+  3, "Quality Improvement",
+  1, "Other",
+  0, "Practice / Just for fun"
+)
+# write the data
+usethis::use_data(project_purpose_labels, overwrite = T)
+
+project_status_labels <- dplyr::tribble(
+  ~id, ~project_status,
+  0, "Development",
+  1, "Production",
+  2, "Inactive",
+  3, "Archived"
+)
+# write the data
+usethis::use_data(project_status_labels, overwrite = T)