[Feature Request] Wrapper function to create ExposureOutcome classes

[mvankessel-EMC]

Right now the createExposureOutcome() function exists, but you are only able to specify one outcomeId, one exposureId, and one nestingCohortId. Which leaves you to define your own code to create them in mass:

diclofenac <- 1124300
negativeControls <- c(
  705178, 705944, 710650, 714785, 719174, 719311, 735340, 742185,
  780369, 781182, 924724, 990760, 1110942, 1111706, 1136601,
  1317967, 1501309, 1505346, 1551673, 1560278, 1584910, 19010309,
  40163731
)
giBleed <- 77

exposuresOutcomeList <- list()
exposuresOutcomeList[[1]] <- createExposuresOutcome(
  outcomeId = giBleed,
  exposures = list(createExposure(exposureId = diclofenac))
)
for (exposureId in c(negativeControls)) {
  exposuresOutcome <- createExposuresOutcome(
    outcomeId = giBleed,
    exposures = list(createExposure(exposureId = exposureId, trueEffectSize = 1))
  )
  exposuresOutcomeList[[length(exposuresOutcomeList) + 1]] <- exposuresOutcome
}

From this vignette

Or you can specify them all manually.

I think a reasonable addition is to add a function that would create them for you. I'm not happy the way nestingIds = NULL is handled to make it run when not nesting within an indication.

makeExposureOutcomes <- function(exposureIds, outcomeIds, trueEffectSize = NA, nestingIds = NULL) {
  # Can't be NULL, otherwise first lapply won't run
  nestingIds <- if (is.null(nestingIds)) {
    c("Not specified")
  } else {
    nestingIds
  }
  lapply(nestingIds, function(nestingId) {
    nestingId <- if (nestingId == "Not specified") {
      NULL
    } else {
       nestingId
    }
    lapply(exposureIds, function(exposureId) {
      lapply(
        X = outcomeIds,
        FUN = SelfControlledCaseSeries::createExposuresOutcome,
        exposures = list(SelfControlledCaseSeries::createExposure(
          exposureId = exposureId,
          trueEffectSize = trueEffectSize
        )), nestingCohortId = nestingId
      )
    }) |>
      unlist(recursive = FALSE)
  }) |>
    unlist(recursive = FALSE)
}

exposures <- c(1:10)
outcomes <- c(11:15)

# Specify ExposureOutcome
exposuresOutcomesList <- makeExposureOutcomes(
  exposureIds = exposures,
  outcomeIds = outcomes,
  nestingIds = NULL
)

length(exposures) * length(outcomes)
#> [1] 50

length(exposuresOutcomesList)
#> [1] 50

exposuresOutcomesList[sample(length(exposuresOutcomesList), size = 1)]
#> [[1]]
#> $outcomeId
#> [1] 13
#> 
#> $exposures
#> $exposures[[1]]
#> $exposureId
#> [1] 9
#> 
#> $exposureIdRef
#> [1] "exposureId"
#> 
#> $trueEffectSize
#> [1] NA
#> 
#> attr(,"class")
#> [1] "Exposure"
#> 
#> 
#> attr(,"class")
#> [1] "ExposuresOutcome"

# Specify with indications / nesting cohorts
indications <- c(16:18)

exposuresOutcomesIndicationsList <- makeExposureOutcomes(
  exposureIds = exposures,
  outcomeIds = outcomes,
  nestingIds = indications
)

length(exposures) * length(outcomes) * length(indications)
#> [1] 150

length(exposuresOutcomesIndicationsList)
#> [1] 150

exposuresOutcomesIndicationsList[sample(length(exposuresOutcomesIndicationsList), size = 1)]
#> [[1]]
#> $outcomeId
#> [1] 12
#> 
#> $exposures
#> $exposures[[1]]
#> $exposureId
#> [1] 8
#> 
#> $exposureIdRef
#> [1] "exposureId"
#> 
#> $trueEffectSize
#> [1] NA
#> 
#> attr(,"class")
#> [1] "Exposure"
#> 
#> 
#> $nestingCohortId
#> [1] 16
#> 
#> attr(,"class")
#> [1] "ExposuresOutcome"

# Specifying negative controls
negControls <- c(123, 456, 789)

ncExposuresOutcomesIndicationsList <- makeExposureOutcomes(
  exposureIds = exposures,
  outcomeIds = negControls,
  trueEffectSize = 1,
  nestingIds = indications
)

length(exposures) * length(negControls) * length(indications)
#> [1] 90

length(ncExposuresOutcomesIndicationsList)
#> [1] 90

ncExposuresOutcomesIndicationsList[sample(length(ncExposuresOutcomesIndicationsList), size = 1)]
#> [[1]]
#> $outcomeId
#> [1] 123
#> 
#> $exposures
#> $exposures[[1]]
#> $exposureId
#> [1] 7
#> 
#> $exposureIdRef
#> [1] "exposureId"
#> 
#> $trueEffectSize
#> [1] 1
#> 
#> attr(,"class")
#> [1] "Exposure"
#> 
#> 
#> $nestingCohortId
#> [1] 17
#> 
#> attr(,"class")
#> [1] "ExposuresOutcome"

# Specifying positive controls
posControls <- c(1231, 4561, 7891)

pcExposuresOutcomesIndicationsList <- makeExposureOutcomes(
  exposureIds = exposures,
  outcomeIds = posControls,
  trueEffectSize = 3,
  nestingIds = indications
)

length(exposures) * length(posControls) * length(indications)
#> [1] 90

length(pcExposuresOutcomesIndicationsList)
#> [1] 90

pcExposuresOutcomesIndicationsList[sample(length(pcExposuresOutcomesIndicationsList), size = 1)]
#> [[1]]
#> $outcomeId
#> [1] 7891
#> 
#> $exposures
#> $exposures[[1]]
#> $exposureId
#> [1] 4
#> 
#> $exposureIdRef
#> [1] "exposureId"
#> 
#> $trueEffectSize
#> [1] 3
#> 
#> attr(,"class")
#> [1] "Exposure"
#> 
#> 
#> $nestingCohortId
#> [1] 16
#> 
#> attr(,"class")
#> [1] "ExposuresOutcome"

^{Created on 2024-09-24 with reprex v2.1.1}

What do you think?