Fixes to pass checks

OHDSI · Apr 17, 2023 · 4592905 · 4592905
1 parent 855fa4d
commit 4592905
Show file tree

Hide file tree

Showing 4 changed files with 25 additions and 22 deletions.
diff --git a/R/CohortDbInterface_R6.R b/R/CohortDbInterface_R6.R
@@ -144,6 +144,7 @@ CohortDbInterface <- R6::R6Class(
       )
       return(cohorts)
     },
+
     #' @description
     #'   Counts cohorts
     #'
@@ -258,7 +259,7 @@ CohortDbInterface <- R6::R6Class(
       metaData$outcomeIds <- outcomeIds
       delta <- Sys.time() - start
       message("Fetching outcomes took ", signif(delta, 3), " ", attr(delta, "units"))
-      return(metaData)
+      return(list(metadata = metaData, outcomes = outcomes))
     },
     #' @description
     #'   Remove temp tables

diff --git a/R/CohortMethodData_R6.R b/R/CohortMethodData_R6.R
@@ -94,7 +94,7 @@ CohortMethodData <- R6::R6Class(
       if (private$preSampleCounts$targetExposures > private$maxCohortSize) {
         message(
           "Downsampling target cohort from ",
-          private$preSampleCounts$targetExposures, " to ", maxCohortSize
+          private$preSampleCounts$targetExposures, " to ", private$maxCohortSize
         )
         private$sampled <- TRUE
       }
@@ -109,7 +109,7 @@ CohortMethodData <- R6::R6Class(
       }
 
       if (private$sampled) {
-        private$sampleCohorts()
+        private$cohortDbInterface$sampleCohorts(private$maxCohortSize)
       }
       return(invisible(self))
     },
@@ -122,6 +122,8 @@ CohortMethodData <- R6::R6Class(
         sampled = private$sampled,
         targetId = private$metaData$targetId
       )
+
+      private$checkCohorts()
       return(invisible(self))
     },
 
@@ -136,24 +138,26 @@ CohortMethodData <- R6::R6Class(
       }
 
       private$handleCohortCovariateBuilders()
-      private$covariateData <- private$cohortDbInterface$extractCovarDat(
+      covariateData <- private$cohortDbInterface$extractCovarDat(
         cohortTable = cohortTable,
         covariateSettings = private$covariateSettings
       )
 
       message("Fetching outcomes from server")
-      private$metaData <- private$cohortDbInterface$getOutcomes(
+      outList <- private$cohortDbInterface$getOutcomes(
         metaData = private$metaData,
         outcomeIds = private$outcomeIds,
         sampled = private$sampled
       )
+      private$metaData <- outList$metadata
       private$cohortDbInterface$rmTempTables(sampled = private$sampled)
 
-      private$covariateData$cohorts <- private$cohorts
-      attr(private$covariateData, "metaData") <- append(attr(private$covariateData, "metaData"), private$metaData)
-      class(private$covariateData) <- "CohortMethodData"
-      attr(class(private$covariateData), "package") <- "CohortMethod"
-      return(private$covariateData)
+      covariateData$cohorts <- private$cohorts
+      covariateData$outcomes <- outList$outcomes
+      attr(covariateData, "metaData") <- append(attr(covariateData, "metaData"), private$metaData)
+      class(covariateData) <- "CohortMethodData"
+      attr(class(covariateData), "package") <- "CohortMethod"
+      return(covariateData)
     }
   ),
   ## Private ----
@@ -172,7 +176,6 @@ CohortMethodData <- R6::R6Class(
     counts = 0,
     preSampleCounts = dplyr::tibble(dummy = 0),
     cohorts = NULL,
-    covariateData = NULL,
     cohortDbInterface = NULL,
 
     ### Methods ----

diff --git a/R/DataLoadingSaving.R b/R/DataLoadingSaving.R
@@ -251,15 +251,15 @@ getDbCohortMethodData_DEP <- function(connectionDetails,
       snakeCaseToCamelCase = TRUE
     )
     if (nrow(rawCount) == 0) {
-      counts <- tibble(
+      counts <- dplyr::tibble(
         description = "Original cohorts",
         targetPersons = 0,
         comparatorPersons = 0,
         targetExposures = 0,
         comparatorExposures = 0
       )
     } else {
-      counts <- tibble(
+      counts <- dplyr::tibble(
         description = "Original cohorts",
         targetPersons = rawCount$exposedCount[rawCount$treatment == 1],
         comparatorPersons = rawCount$exposedCount[rawCount$treatment == 0],
@@ -291,21 +291,21 @@ getDbCohortMethodData_DEP <- function(connectionDetails,
       metaData$attrition <-
         rbind(metaData$attrition, preSampleCounts)
       metaData$attrition <-
-        rbind(metaData$attrition, getCounts(cohorts, "Random sample"))
+        rbind(metaData$attrition, CohortMethod:::getCounts(cohorts, "Random sample"))
     } else {
       metaData$attrition <-
-        rbind(metaData$attrition, getCounts(cohorts, label))
+        rbind(metaData$attrition, CohortMethod:::getCounts(cohorts, label))
     }
   } else {
     if (sampled) {
       preSampleCounts$description <- "Original cohorts"
       metaData$attrition <- preSampleCounts
       metaData$attrition <- rbind(
         metaData$attrition,
-        getCounts(cohorts, "Random sample")
+        CohortMethod:::getCounts(cohorts, "Random sample")
       )
     } else {
-      metaData$attrition <- getCounts(cohorts, "Original cohorts")
+      metaData$attrition <- CohortMethod:::getCounts(cohorts, "Original cohorts")
     }
   }
   delta <- Sys.time() - start
@@ -332,7 +332,7 @@ getDbCohortMethodData_DEP <- function(connectionDetails,
   )
   ParallelLogger::logDebug(
     "Fetched covariates total count is ",
-    nrow_temp(covariateData$covariates)
+    CohortMethod:::nrow_temp(covariateData$covariates)
   )
   message("Fetching outcomes from server")
   start <- Sys.time()
@@ -395,7 +395,7 @@ downSample <- function(connection,
   )
   counts <- DatabaseConnector::querySql(connection, renderedSql, snakeCaseToCamelCase = TRUE)
   ParallelLogger::logDebug("Pre-sample total row count is ", sum(counts$rowCount))
-  preSampleCounts <- bind_cols(
+  preSampleCounts <- dplyr::bind_cols(
     countPreSample(id = 1, counts = counts),
     countPreSample(id = 0, counts = counts)
   )
@@ -427,7 +427,7 @@ downSample <- function(connection,
 }
 
 countPreSample <- function(id, counts) {
-  preSampleCounts <- tibble(dummy = 0)
+  preSampleCounts <- dplyr::tibble(dummy = 0)
   idx <- which(counts$treatment == id)
 
   switch(id + 1,

diff --git a/R/DataLoadingSaving_R6.R b/R/DataLoadingSaving_R6.R
@@ -171,6 +171,5 @@ getDbCohortMethodData <- function(
     "Fetching cohorts took ", signif(delta, 3), " ", attr(delta, "units")
   )
 
-  covariateData <- cohortMethodData$buildCovariateData()
-  return(covariateData)
+  return(cohortMethodData$buildCovariateData())
 }