Merge pull request #299 from OHDSI/297-sample-function

sample option

R/summariseClinicalRecords.R

@@ -22,8 +22,6 @@
 #' @param ageGroup A list of age groups to stratify results by.
 #' @param sex Boolean variable. Whether to stratify by sex (TRUE) or not
 #' (FALSE).
-#' @param sample An integer to sample the tables to only that number of records.
-#' If NULL no sample is done.
 #' @param dateRange A list containing the minimum and the maximum dates
 #' defining the time range within which the analysis is performed.
 #' @return A summarised_result object.
@@ -57,7 +55,6 @@ summariseClinicalRecords <- function(cdm,
                                      typeConcept = TRUE,
                                      sex = FALSE,
                                      ageGroup = NULL,
-                                     sample = NULL,
                                      dateRange = NULL) {
   # Initial checks ----
   cdm <- omopgenerics::validateCdmArgument(cdm)
@@ -78,7 +75,7 @@ summariseClinicalRecords <- function(cdm,
   omopgenerics::assertLogical(typeConcept, length = 1)
   omopgenerics::assertLogical(sex, length = 1)
   ageGroup <- omopgenerics::validateAgeGroupArgument(ageGroup, multipleAgeGroup = FALSE)
-  omopgenerics::assertNumeric(sample, integerish = TRUE, min = 1, null = TRUE, length = 1)
+
 
   # warnings for observation_period
   warnStandardConcept <- standardConcept & !missing(standardConcept)

R/summariseConceptSetCounts.R

@@ -10,8 +10,6 @@
 #' @param sex TRUE or FALSE. If TRUE code use will be summarised by sex.
 #' @param ageGroup A list of ageGroup vectors of length two. Code use will be
 #' thus summarised by age groups.
-#' @param sample An integer to sample the tables in the cdm object to only that number of records.
-#' If NULL no sample is done.
 #' @param dateRange A list containing the minimum and the maximum dates
 #' defining the time range within which the analysis is performed.
 #' @return A summarised_result object with results overall and, if specified, by
@@ -39,7 +37,6 @@ summariseConceptSetCounts <- function(cdm,
                                       interval = "overall",
                                       sex = FALSE,
                                       ageGroup = NULL,
-                                      sample = NULL,
                                       dateRange = NULL) {
   # initial check
   cdm <- omopgenerics::validateCdmArgument(cdm)
@@ -49,7 +46,6 @@ summariseConceptSetCounts <- function(cdm,
   omopgenerics::assertLogical(sex, length = 1)
   ageGroup <- omopgenerics::validateAgeGroupArgument(ageGroup)
   dateRange <- validateStudyPeriod(cdm, dateRange)
-  omopgenerics::assertNumeric(sample, integerish = TRUE, min = 0, null = TRUE, length = 1)
   conceptSet <- omopgenerics::validateConceptSetArgument(conceptSet = conceptSet)
 
   countBy[countBy == "record"] <- "records"

R/summariseInternal.R

@@ -78,20 +78,10 @@ sampleOmopTable <- function(x, sample, name) {
   if (is.infinite(sample)) return(x)
   if (x |> dplyr::tally() |> dplyr::pull() <= sample) return(x)
 
-  cdm <- omopgenerics::cdmReference(x)
-  id <- omopgenerics::omopColumns(table = omopgenerics::tableName(x), field = "unique_id")
-  idTibble <- x |>
-    dplyr::pull(dplyr::all_of(id)) |>
-    base::sample(size = sample) |>
-    list() |>
-    rlang::set_names(id) |>
-    dplyr::as_tibble()
-  idName <- "ids_sample"
-  cdm <- omopgenerics::insertTable(cdm = cdm, name = idName, table = idTibble)
   x <- x |>
-    dplyr::inner_join(cdm[[idName]], by = id) |>
+    dplyr::slice_sample(n = sample) |>
     dplyr::compute(name = name, temporary = FALSE)
-  omopgenerics::dropSourceTable(cdm = cdm, name = idName)
+
   return(x)
 }
 addStratifications <- function(x, indexDate, sex, ageGroup, interval, intervalName, name) {

R/summariseRecordCount.R

@@ -70,6 +70,10 @@ summariseRecordCount <- function(cdm,
     # prefix for temp tables
     prefix <- omopgenerics::tmpPrefix()
 
+    # sample table
+    omopTable <- omopTable |>
+      sampleOmopTable(sample = sample, name = omopgenerics::uniqueTableName(prefix))
+
     startDate <- omopgenerics::omopColumns(table = table, field = "start_date")
 
     # Incidence counts

cran-comments.md

@@ -3,4 +3,3 @@
 0 errors | 0 warnings | 1 note
 
 * This is a new release.
-* There is a change of maintainer: Marta Alcalde-Herraiz -> Cecilia Campanile

tests/testthat/test-summariseClinicalRecords.R

@@ -268,20 +268,6 @@ test_that("dateRange argument works", {
 
 })
 
-test_that("sample argument works", {
-  skip_on_cran()
-  # Load mock database ----
-  cdm <- cdmEunomia()
-
-  expect_no_error(x<-summariseClinicalRecords(cdm,"drug_exposure", sample = 50))
-  expect_no_error(y<-summariseClinicalRecords(cdm,"drug_exposure"))
-  n <- cdm$drug_exposure |>
-    dplyr::tally()|>
-    dplyr::pull(n)
-  expect_no_error(z<-summariseClinicalRecords(cdm,"drug_exposure",sample = n))
-  expect_equal(y,z)
-  PatientProfiles::mockDisconnect(cdm = cdm)
-})
 
 test_that("tableClinicalRecords() works", {
   skip_on_cran()
@@ -327,8 +313,7 @@ test_that("no tables created", {
                                        ageGroup = list(c(0,17),
                                                        c(18,65),
                                                        c(66, 100)),
-                                       dateRange = as.Date(c("2012-01-01", "2018-01-01")),
-                                       sample = 100)
+                                       dateRange = as.Date(c("2012-01-01", "2018-01-01")))
 
   endNames <- CDMConnector::listSourceTables(cdm)
 

tests/testthat/test-summariseConceptIdCounts.R

@@ -97,6 +97,11 @@ test_that("sample argument works", {
     dplyr::pull(n)
   expect_no_error(z<-summariseConceptIdCounts(cdm,"drug_exposure",sample = n))
   expect_equal(y |> sortTibble(), z |> sortTibble())
+  expect_equal(summariseConceptIdCounts(cdm,"drug_exposure", sample = 1) |>
+                 dplyr::filter(.data$estimate_name == "Number records") |>
+                 dplyr::pull(.data$estimate_value) |>
+                 as.integer(), 1L)
+
   PatientProfiles::mockDisconnect(cdm = cdm)
 })
 

tests/testthat/test-summariseConceptSetCounts.R

@@ -559,21 +559,6 @@ test_that("dateRange argument works", {
   PatientProfiles::mockDisconnect(cdm = cdm)
 })
 
-test_that("sample argument works", {
-  skip_on_cran()
-  # Load mock database ----
-  cdm <- cdmEunomia()
-
-  expect_no_error(d<-summariseConceptSetCounts(cdm,conceptSet = list("zoster vax" = c(40213260)), sample = 50))
-  expect_no_error(y<-summariseConceptSetCounts(cdm,conceptSet = list("zoster vax" = c(40213260))))
-  n <- cdm$drug_exposure |>
-    dplyr::tally()|>
-    dplyr::pull(n)
-  expect_no_error(z<-summariseConceptSetCounts(cdm,conceptSet = list("zoster vax" = c(40213260)),sample = n))
-  expect_equal(y,z)
-  PatientProfiles::mockDisconnect(cdm = cdm)
-})
-
 test_that("interval argument works", {
   skip_on_cran()
   # Load mock database ----

tests/testthat/test-summariseRecordCount.R

@@ -317,6 +317,10 @@ test_that("sample argument works", {
     dplyr::pull(n)
   expect_no_error(z<-summariseRecordCount(cdm,"drug_exposure",sample = n))
   expect_equal(y,z)
+  expect_equal(summariseRecordCount(cdm,"drug_exposure", sample = 1) |>
+                 dplyr::filter(.data$variable_name == "Number records") |>
+                 dplyr::pull(.data$estimate_value) |>
+                 as.integer(), 1L)
   PatientProfiles::mockDisconnect(cdm = cdm)
 })