From 7365ac0b4f808613cafecd02aec1fb001bf29f2c Mon Sep 17 00:00:00 2001 From: "Lavallee,Dr.,Martin (MED MA) BIP-US-R" Date: Thu, 24 Oct 2024 12:32:44 -0400 Subject: [PATCH 1/3] add execution settings --- R/executionSettings.R | 167 ++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 167 insertions(+) create mode 100644 R/executionSettings.R diff --git a/R/executionSettings.R b/R/executionSettings.R new file mode 100644 index 0000000..fca6cf3 --- /dev/null +++ b/R/executionSettings.R @@ -0,0 +1,167 @@ + +# ExecutionSettings ---- + +#' @description +#' An R6 class to define an ExecutionSettings object +#' +#' @export +ExecutionSettings <- R6::R6Class( + classname = "ExecutionSettings", + public = list( + initialize = function(connectionDetails = NULL, + connection = NULL, + cdmDatabaseSchema = NULL, + workDatabaseSchema = NULL, + tempEmulationSchema = NULL, + targetCohortTable = NULL, + cdmSourceName = NULL) { + stopifnot(is.null(connectionDetails) || is.null(connection)) + .setClass(private = private, key = "connectionDetails", value = connectionDetails, class = "ConnectionDetails") + .setClass(private = private, key = ".connection", value = connection, + class = "DatabaseConnectorJdbcConnection", nullable = TRUE) + .setString(private = private, key = ".cdmDatabaseSchema", value = cdmDatabaseSchema) + .setString(private = private, key = ".workDatabaseSchema", value = workDatabaseSchema) + .setString(private = private, key = ".tempEmulationSchema", value = tempEmulationSchema) + .setString(private = private, key = ".targetCohortTable", value = targetCohortTable) + .setString(private = private, key = ".cdmSourceName", value = cdmSourceName) + }, + + getDbms = function() { + dbms <- private$connectionDetails$dbms + return(dbms) + }, + + # connect to database + connect = function() { + + # check if private$connection is NULL + conObj <- private$.connection + if (is.null(conObj)) { + private$.connection <- DatabaseConnector::connect(private$connectionDetails) + } else{ + cli::cat_bullet( + "Connection object already open", + bullet = "info", + bullet_col = "blue" + ) + } + }, + + # disconnect to database + disconnect = function() { + + # check if private$connection is NULL + conObj <- private$.connection + if (class(conObj) == "DatabaseConnectorJdbcConnection") { + # disconnect connection + DatabaseConnector::disconnect(private$.connection) + private$.connection <- NULL + } + + cli::cat_bullet( + "Connection object has been disconected", + bullet = "info", + bullet_col = "blue" + ) + invisible(conObj) + }, + + #TODO make this more rigorous + # add warning if no connection available + getConnection = function() { + conObj <- private$.connection + return(conObj) + } + + ), + + private = list( + connectionDetails = NULL, + .connection = NULL, + .cdmDatabaseSchema = NULL, + .workDatabaseSchema = NULL, + .tempEmulationSchema = NULL, + .targetCohortTable = NULL, + .cdmSourceName = NULL + ), + + active = list( + + cdmDatabaseSchema = function(value) { + # return the value if nothing added + if(missing(value)) { + cds <- private$.cdmDatabaseSchema + return(cds) + } + # replace the cdmDatabaseSchema + .setString(private = private, key = ".cdmDatabaseSchema", value = value) + cli::cat_bullet( + glue::glue("Replaced {crayon::cyan('cdmDatabaseSchema')} with {crayon::green(value)}"), + bullet = "info", + bullet_col = "blue" + ) + }, + + workDatabaseSchema = function(value) { + # return the value if nothing added + if(missing(value)) { + cds <- private$.workDatabaseSchema + return(cds) + } + # replace the workDatabaseSchema + .setString(private = private, key = ".workDatabaseSchema", value = value) + cli::cat_bullet( + glue::glue("Replaced {crayon::cyan('workDatabaseSchema')} with {crayon::green(value)}"), + bullet = "info", + bullet_col = "blue" + ) + }, + + + tempEmulationSchema = function(value) { + # return the value if nothing added + if(missing(value)) { + tes <- private$.tempEmulationSchema + return(tes) + } + # replace the tempEmulationSchema + .setString(private = private, key = ".tempEmulationSchema", value = value) + cli::cat_bullet( + glue::glue("Replaced {crayon::cyan('tempEmulationSchema')} with {crayon::green(value)}"), + bullet = "info", + bullet_col = "blue" + ) + }, + + targetCohortTable = function(value) { + # return the value if nothing added + if(missing(value)) { + tct <- private$.targetCohortTable + return(tct) + } + # replace the targetCohortTable + .setString(private = private, key = ".targetCohortTable", value = value) + cli::cat_bullet( + glue::glue("Replaced {crayon::cyan('targetCohortTable')} with {crayon::green(value)}"), + bullet = "info", + bullet_col = "blue" + ) + }, + + cdmSourceName = function(value) { + # return the value if nothing added + if(missing(value)) { + csn <- private$.cdmSourceName + return(csn) + } + # replace the cdmSourceName + .setString(private = private, key = ".cdmSourceName", value = value) + cli::cat_bullet( + glue::glue("Replaced {crayon::cyan('cdmSourceName')} with {crayon::green(value)}"), + bullet = "info", + bullet_col = "blue" + ) + } + + ) +) From 3c923f07cf77d7afdc6a081a0a49022eaea0f8d8 Mon Sep 17 00:00:00 2001 From: "Lavallee,Dr.,Martin (MED MA) BIP-US-R" Date: Thu, 24 Oct 2024 14:05:08 -0400 Subject: [PATCH 2/3] add createExecutionSettings --- R/executionSettings.R | 31 +++++++++++++++++++++++++++++++ 1 file changed, 31 insertions(+) diff --git a/R/executionSettings.R b/R/executionSettings.R index fca6cf3..48e4788 100644 --- a/R/executionSettings.R +++ b/R/executionSettings.R @@ -165,3 +165,34 @@ ExecutionSettings <- R6::R6Class( ) ) + + +#' @title +#' Create an ExecutionSettings object and set its attributes +#' +#' @param connectionDetails A DatabaseConnector connectionDetails object (optional if connection is specified) +#' @param connection A DatabaseConnector connection object (optional if connectionDetails is specified) +#' @param cdmDatabaseSchema The schema of the OMOP CDM database +#' @param workDatabaseSchema The schema to which results will be written +#' @param tempEmulationSchema Some database platforms like Oracle and Snowflake do not truly support temp tables. To emulate temp tables, provide a schema with write privileges where temp tables can be created. +#' @param targetCohortTable The name of the table where the target cohort(s) are stored +#' @param cdmSourceName A human-readable name for the OMOP CDM source +#' +#' @return An ExecutionSettings object +#' @export +createExecutionSettings <- function(connectionDetails, + connection = NULL, + cdmDatabaseSchema, + workDatabaseSchema, + tempEmulationSchema, + targetCohortTable, + cdmSourceName) { + executionSettings <- ExecutionSettings$new(connectionDetails = connectionDetails, + connection = connection, + cdmDatabaseSchema = cdmDatabaseSchema, + workDatabaseSchema = workDatabaseSchema, + tempEmulationSchema = tempEmulationSchema, + targetCohortTable = targetCohortTable, + cdmSourceName = cdmSourceName) + return(executionSettings) +} \ No newline at end of file From df94fc2827cce6d8f7f0a25e96c4a483093f44be Mon Sep 17 00:00:00 2001 From: "Lavallee,Dr.,Martin (MED MA) BIP-US-R" Date: Fri, 25 Oct 2024 16:09:03 -0400 Subject: [PATCH 3/3] add R6 class checkmate fn --- R/R6ClassFunctions.R | 99 ++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 99 insertions(+) create mode 100644 R/R6ClassFunctions.R diff --git a/R/R6ClassFunctions.R b/R/R6ClassFunctions.R new file mode 100644 index 0000000..8b475ce --- /dev/null +++ b/R/R6ClassFunctions.R @@ -0,0 +1,99 @@ + +.getAssertChoices <- function(category) { + readr::read_csv(file = system.file(package = pkgload::pkg_name(), "csv", "assertChoices.csv"), show_col_types = FALSE) |> + dplyr::filter(category == !!category) |> + dplyr::pull(choice) +} + +.getCaseSql <- function(covariateValues, + then) { + + sql <- glue::glue("when covariate_value >= {thresholdMin} and covariate_value <= {thresholdMax} then {covariateId}") + caseSql <- glue::glue("case {sql} end as covariate_id", sql = paste(caseSql, collapse = "\n")) +} + +.setString <- function(private, key, value, naOk = FALSE) { + checkmate::assert_string(x = value, na.ok = naOk, min.chars = 1, null.ok = FALSE) + private[[key]] <- value + invisible(private) +} + +.setCharacter <- function(private, key, value) { + checkmate::assert_character(x = value, min.chars = 1, null.ok = FALSE) + private[[key]] <- value + invisible(private) +} + +.setNumber <- function(private, key, value, nullable = FALSE) { + checkmate::assert_numeric(x = value, null.ok = nullable) + private[[key]] <- value + invisible(private) +} + +.setInteger <- function(private, key, value, nullable = FALSE) { + checkmate::assert_integer(x = value, null.ok = nullable) + private[[key]] <- value + invisible(private) +} + + +.setLogical <- function(private, key, value) { + checkmate::assert_logical(x = value, null.ok = FALSE) + private[[key]] <- value + invisible(private) +} + +.setClass <- function(private, key, value, class, nullable = FALSE) { + checkmate::assert_class(x = value, classes = class, null.ok = nullable) + private[[key]] <- value + invisible(private) +} + +.setListofClasses <- function(private, key, value, classes) { + checkmate::assert_list(x = value, types = classes, null.ok = FALSE, min.len = 1) + private[[key]] <- value + invisible(private) +} + +.setChoice <- function(private, key, value, choices) { + checkmate::assert_choice(x = value, choices = choices, null.ok = FALSE) + private[[key]] <- value + invisible(private) +} + +.setChoiceList <- function(private, key, value, choices) { + checkmate::assert_subset(x = value, choices = choices, empty.ok = FALSE) + private[[key]] <- value + invisible(private) +} + + +.setActiveLogical <- function(private, key, value) { + # return the value if nothing added + if(missing(value)) { + vv <- private[[key]] + return(vv) + } + # replace the codesetTempTable + .setLogical(private = private, key = key, value = value) +} + +.setActiveString <- function(private, key, value) { + # return the value if nothing added + if(missing(value)) { + vv <- private[[key]] + return(vv) + } + # replace the codesetTempTable + .setString(private = private, key = key, value = value) +} + + +.setActiveInteger <- function(private, key, value) { + # return the value if nothing added + if(missing(value)) { + vv <- private[[key]] + return(vv) + } + .setInteger(private = private, key = key, value = value) +}