Merge pull request #26 from oxford-pharmacoepi/fix-mockcohort

fixes

NAMESPACE

@@ -10,6 +10,7 @@ export(dropTable)
 export(emptyCdmReference)
 export(insertTable)
 export(mockCdmFromTable)
+export(mockCdmRefernce)
 export(mockCohort)
 export(mockObservationPeriod)
 export(mockPerson)

R/mockCdmReference.R

@@ -0,0 +1,24 @@
+
+
+#' Function to create empty cdm reference for mock database
+#'
+#' @param cdmName name of the mock cdm object
+#'
+#' @return an empty cdm object
+#'
+#' @examples
+#' \donttest{
+#' library(omock)
+#' }
+#' @export
+
+mockCdmRefernce <- function(cdmName = "mock database"){
+
+  checkInput(TableName = cdmName)
+
+
+  cdm <- omopgenerics::emptyCdmReference(cdmName = cdmName)
+
+  return(cdm)
+
+}

R/mockCohort.R

@@ -7,7 +7,6 @@
 #' @param cohortName name of the cohort within the table
 #' @param recordPerson the expected number of record per person
 #' @param seed random seed
-#' @param cohort custom cohort
 #'
 #' @return A cdm reference with the mock tables
 #' @examples
@@ -20,7 +19,6 @@ mockCohort <- function(cdm,
                        numberCohorts = 1,
                        cohortName = paste0("cohort_", seq_len(numberCohorts)),
                        recordPerson = 1,
-                       cohort = NULL,
                        seed = 1) {
 
   # initial checks
@@ -51,17 +49,17 @@ mockCohort <- function(cdm,
   cohortId = seq_len(numberCohorts)
 
   #number of rows per cohort
-  numberRows <-
+  numberRows_to_keep <-
     recordPerson * (cdm$person |> dplyr::tally() |> dplyr::pull()) |> round()
 
-  if (is.null(nrow(cohort))) {
+
     # generate cohort table
     cohort <- list()
-    if (length(numberRows) == 1) {
-      numberRows <- rep(numberRows, length(cohortId))
+    if (length(numberRows_to_keep) == 1) {
+      numberRows <- rep(numberRows_to_keep*1.2, length(cohortId))
     }
     for (i in seq_along(cohortId)) {
-      num <- numberRows[[i]]
+      num <- numberRows_to_keep[[i]]*1.2
       cohort[[i]] <- dplyr::tibble(
         cohort_definition_id = cohortId[i],
         subject_id = sample(
@@ -98,11 +96,14 @@ mockCohort <- function(cdm,
               !is.na(.data$next_observation),
             .data$next_observation - 1,
             .data$cohort_end_date
-          )
-      ) |> dplyr::ungroup() |> dplyr::select(-"next_observation")
+        ),
+        cohort_end_date = dplyr::if_else(.data$cohort_end_date < .data$cohort_start_date,
+                                         NA,.data$cohort_end_date)
+      ) |> dplyr::ungroup() |> dplyr::select(-"next_observation") |> stats::na.omit() |>
+      dplyr::distinct() |> dplyr::slice(1:numberRows_to_keep)
+
 
 
-  }
   # generate cohort set table
 
   cohortName <- snakecase::to_snake_case(cohortName)
@@ -124,6 +125,9 @@ mockCohort <- function(cdm,
   return(cdm)
 }
 
+
+
+
 addCohortDates <-
   function(x,
            start = "cohort_start_date",

R/mockPerson.R

@@ -19,7 +19,7 @@ mockPerson <- function(cdm,
                        birthRange = c("1950-01-01", "2000-12-31"),
                        seed = 1) {
   checkInput(cdm = cdm)
-  if (nrow(cdm$person) == 0) {
+##  if (nrow(cdm$person) == 0) {
     checkInput(nPerson = nPerson,
                birthRange = birthRange,
                seed = seed)
@@ -56,7 +56,7 @@ mockPerson <- function(cdm,
       omopgenerics::insertTable(cdm = cdm,
                                 name = "person",
                                 table = person)
-  }
+##  }
 
   return(cdm)
 }

tests/testthat/test-mockCohort.R

@@ -1,3 +1,16 @@
-test_that("multiplication works", {
-  expect_equal(2 * 2, 4)
+test_that("stress test", {
+
+testthat::expect_no_error(omock::emptyCdmReference(cdmName = "mock") |> omock::mockPerson(nPerson = 100) |>
+                            omock::mockObservationPeriod() |> omock::mockCohort())
+
+testthat::expect_no_error(omock::emptyCdmReference(cdmName = "mock") |> omock::mockPerson(nPerson = 1000) |>
+                              omock::mockObservationPeriod() |> omock::mockCohort())
+
+testthat::expect_no_error(omock::emptyCdmReference(cdmName = "mock") |> omock::mockPerson(nPerson = 10000) |>
+                            omock::mockObservationPeriod() |> omock::mockCohort())
+
+testthat::expect_no_error(omock::emptyCdmReference(cdmName = "mock") |> omock::mockPerson(nPerson = 20000) |>
+                            omock::mockObservationPeriod() |> omock::mockCohort())
+
+
 })