tests/testthat/test-simulation.R

In OHDSI/PatientLevelPrediction: Develop Clinical Prediction Models Using the Common Data Model

# @file test-simulation.R
# Copyright 2025 Observational Health Data Sciences and Informatics
#
# This file is part of PatientLevelPrediction
#
# Licensed under the Apache License, Version 2.0 (the "License");
# you may not use this file except in compliance with the License.
# You may obtain a copy of the License at
#
#     http://www.apache.org/licenses/LICENSE-2.0
#
# Unless required by applicable law or agreed to in writing, software
# distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and
# limitations under the License.

test_that("create simulation profile works", {
  cohorts <- data.frame(rowId = 1:10, subjectId = 1:10, targetId = rep(1, 10))
  covariates <- data.frame(
    rowId = c(rep(1:10, each = 2), 1:10),
    covariateId = c(rep(c(1002, 14310024102), 10), rep(8532, 10)),
    covariateValue = c(stats::runif(20), stats::rbinom(10, 1, 0.5))
  )
  covariateRef <- data.frame(
    covariateId = c(1002, 14310024102, 8532),
    covariateName = c("cont1", "cont2", "bin1"),
    analysisId = c(1, 1, 2)
  )
  analysisRef <- data.frame(
    analysisId = c(1, 2),
    analysisName = c("continuous", "binary"),
    isBinary = c("N", "Y")
  )
  outcomes <- data.frame(
    rowId = c(1, 2, 3, 4, 5),
    daysToEvent = c(80, 90, 100, 110, 120)
  )
  metaData <- list(
    databaseDetails = list(outcomeIds = c(1))
  )
  simData <- list(
    cohorts = cohorts,
    outcomes = outcomes,
    metaData = metaData,
    covariateData = list(
      covariates = covariates,
      covariateRef = covariateRef,
      analysisRef = analysisRef
    )
  )
  simProfile <- createSimulationProfile(simData)
  expect_type(simProfile, "list")
  expect_s3_class(simProfile, "plpDataSimulationProfile")
  expect_true(all(c(
    "covariateInfo", "timeMax", "outcomeRate",
    "outcomeModels", "metaData", "covariateRef"
  ) %in% names(simProfile)))

  prevalence <- simProfile$covariateInfo$covariatePrevalence
  expect_type(prevalence, "double")
  expect_equal(as.numeric(prevalence["1002"]), 1)
  expect_equal(as.numeric(prevalence["8532"]), 1)
  expect_equal(as.numeric(prevalence["14310024102"]), 1)

  continuousCovs <- simProfile$covariateInfo$continuousCovariates
  expect_equal(nrow(continuousCovs), 2)
  expect_equal(continuousCovs$covariateId, c(1002, 14310024102))
  expect_equal(simProfile$outcomeRate, 0.5)
  expect_equal(simProfile$timeMax, max(outcomes$daysToEvent))
  expect_equal(
    length(simProfile$outcomeModels),
    length(metaData$databaseDetails$outcomeIds)
  )
  expect_true(all(list("(Intercept)" = -2.0, "1002" = 0.04, "8532" = 0.50)
  %in% simProfile$outcomeModels[[1]]))
  expect_equal(simProfile$metaData, metaData)
  expect_equal(simProfile$covariateRef, as.data.frame(covariateRef))
})

test_that("simulatePlpData works", {
  # mock predictCyclops function
  predictCyclopsType <- function(coefficients, cohorts, covariateData, modelType) {
    data.frame(rowId = cohorts$rowId, value = rep(0.5, nrow(cohorts)))
  }
  dummyProfile <- list(
    covariateInfo = list(
      covariatePrevalence = c("1002" = 1, "8532" = 0.3, "2001" = 0.5), continuousCovariates = data.frame(
        covariateId = 1002,
        mean = 50,
        sd = 5,
        min = 30,
        max = 70
      )
    ),
    covariateRef = data.frame(
      covariateId = 2001,
      covariateName = "continuous feature",
      stringsAsFactors = FALSE
    ), timeMax = c(100), outcomeModels = list(c("(Intercept)" = -2, "1002" = 0.04, "8532" = 0.05)),
    metaData = list(
      databaseDetails = list(
        outcomeIds = 3
      )
    )
  )

  n <- 100 # population size for the simulation
  simData <- simulatePlpData(dummyProfile, n = n)
  expect_s3_class(simData, "plpData")
  expect_true(is.data.frame(simData$cohorts))
  expect_equal(nrow(simData$cohorts), n)
  expect_true("rowId" %in% names(simData$cohorts))
  expect_true("subjectId" %in% names(simData$cohorts))
  expect_true("targetId" %in% names(simData$cohorts))
  expect_true("cohortStartDate" %in% names(simData$cohorts))
  expect_s3_class(simData$cohorts$cohortStartDate, "Date")
  expect_s4_class(simData$covariateData, "CovariateData")
  expect_true("covariates" %in% names(simData$covariateData))
  expect_true("covariateRef" %in% names(simData$covariateData))
  expect_true("analysisRef" %in% names(simData$covariateData))
  covMeta <- attr(simData$covariateData, "metaData")
  expect_type(covMeta, "list")
  expect_equal(covMeta$populationSize, n)
  expect_true(is.data.frame(simData$outcomes))
  if (nrow(simData$outcomes) > 0) {
    for (col in c("rowId", "outcomeId", "outcomeCount", "daysToEvent")) {
      expect_true(col %in% names(simData$outcomes))
    }
  }
  expect_true(is.list(simData$metaData))
  expect_true("databaseDetails" %in% names(simData$metaData))
  expect_equal(simData$metaData$databaseDetails$cdmDatabaseSchema, "CDM_SCHEMA")
  expect_equal(simData$metaData$databaseDetails$cdmDatabaseName, "CDM_NAME") 
  expect_equal(simData$metaData$databaseDetails$cdmVersion, 5)
  expect_equal(simData$metaData$databaseDetails$targetId, 1) 
  expect_equal(simData$metaData$databaseDetails$outcomeIds, 3)
})