tests/testthat/test-simulation.R

In CohortMethod: Comparative Cohort Method with Large Scale Propensity and Outcome Models

library(CohortMethod)
library(testthat)

if (!isFALSE(tryCatch(find.package("Eunomia"), error = function(e) FALSE))) {

  # Eunomia connection details set in setup.R

  test_that("createCohortMethodDataSimulationProfile", {
    covarSettings <- FeatureExtraction::createCovariateSettings(
      useDemographicsGender = TRUE,
      useDemographicsAge = TRUE,
      useDemographicsAgeGroup = TRUE,
      useDemographicsIndexMonth = TRUE,
      useDemographicsPriorObservationTime = TRUE,
      useDemographicsPostObservationTime = TRUE,
      useDemographicsTimeInCohort = TRUE,
      useDemographicsIndexYearMonth = TRUE,
      useMeasurementValueLongTerm = TRUE,
      useMeasurementValueMediumTerm = TRUE,
      useMeasurementValueShortTerm = TRUE,
      useMeasurementRangeGroupAnyTimePrior = TRUE,
      useMeasurementRangeGroupLongTerm = TRUE,
      useMeasurementRangeGroupMediumTerm = TRUE,
      useMeasurementRangeGroupShortTerm = TRUE,
      useObservationAnyTimePrior = TRUE,
      useObservationLongTerm = TRUE,
      useObservationMediumTerm = TRUE,
      useObservationShortTerm = TRUE,
      endDays = 180
    )

    cohortMethodData <- getDbCohortMethodData(
      connectionDetails = connectionDetails,
      cdmDatabaseSchema = "main",
      exposureTable = "cohort",
      outcomeTable = "cohort",
      targetId = 1,
      comparatorId = 2,
      outcomeIds = c(3, 4),
      getDbCohortMethodDataArgs = createGetDbCohortMethodDataArgs(
        washoutPeriod = 183,
        firstExposureOnly = TRUE,
        removeDuplicateSubjects = "keep all",
        restrictToCommonPeriod = TRUE,
        maxCohortSize = 100000,
        covariateSettings = covarSettings
      )
    )


    cohorts <- data.frame(cohortMethodData$cohorts)
    cohorts$daysToCohortEnd <- rexp(nrow(cohorts), rate = 10)
    cohortMethodData$cohorts <- cohorts

    cohortDataSimulationProfile <- createCohortMethodDataSimulationProfile(cohortMethodData)

    # Basic checks to see if output simulated data are meaninful
    expect_s3_class(cohortDataSimulationProfile, "CohortDataSimulationProfile")
    expect_true(cohortDataSimulationProfile$cohortEndRate > 0)
    expect_true(cohortDataSimulationProfile$obsStartRate > 0)
    expect_true(cohortDataSimulationProfile$obsEndRate > 0)

    truncatedProfile <- CohortMethod:::.truncateSimulationProfile(cohortDataSimulationProfile, 100)

    minPrevalenceAfterTruncation <- truncatedProfile$covariatePrevalence |>
      filter(prevalence > 0) |>
      summarize(min(prevalence)) |>
      pull()

    minPrevalenceBeforeTruncation <- cohortDataSimulationProfile$covariatePrevalence |>
      filter(prevalence > 0) |>
      summarize(min(prevalence)) |>
      pull()

    # test truncation of covariate prevalence
    expect_true(minPrevalenceAfterTruncation > minPrevalenceBeforeTruncation)
  })
}