Fixed problem when splitting covariate and not stratifying by ID

OHDSI · Aug 28, 2017 · 550e641 · 550e641
1 parent 1a2fe1e
commit 550e641
Show file tree

Hide file tree

Showing 6 changed files with 100 additions and 4 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,8 +1,8 @@
 Package: SelfControlledCaseSeries
 Type: Package
 Title: Self-Controlled Case Series
-Version: 1.1.1
-Date: 2017-07-05
+Version: 1.1.2
+Date: 2017-08-28
 Author: Martijn Schuemie, Patrick Ryan, Trevor Shaddox, Marc A. Suchard
 Maintainer: Martijn Schuemie <schuemie@ohdsi.org>
 Description: SelfControlledCaseSeries is an R package for performing self-

diff --git a/R/DataConversion.R b/R/DataConversion.R
@@ -358,7 +358,10 @@ addCovariateSettings <- function(settings, covariateSettings, sccsData) {
         outputId <- outputId + length(covariateSettings$splitPoints) + 1
         varNames <- rep(covariateSettings$label, length(covariateSettings$splitPoints) + 1)
         varNames <- paste(varNames, " day ", startDays, "-", c(endDays[1:length(endDays) - 1], ""))
-        covariateSettings$outputIds <- matrix(outputIds, ncol = 1)
+        # covariateSettings$outputIds <- matrix(outputIds, ncol = 1)
+        covariateSettings$outputIds <- matrix(outputIds,
+                                              ncol = length(covariateSettings$splitPoints) + 1,
+                                              byrow = TRUE)
         newCovariateRef <- data.frame(covariateId = outputIds,
                                       covariateName = varNames,
                                       originalCovariateId = 0,

diff --git a/R/Power.R b/R/Power.R
@@ -1,6 +1,6 @@
 # @file Power.R
 #
-# Copyright 2016 Observational Health Data Sciences and Informatics
+# Copyright 2017 Observational Health Data Sciences and Informatics
 #
 # This file is part of SelfControlledCaseSeries
 #

diff --git a/extras/SelfControlledCaseSeries.pdf b/extras/SelfControlledCaseSeries.pdf
diff --git a/extras/SplittingSimulations.R b/extras/SplittingSimulations.R
@@ -0,0 +1,29 @@
+library(SelfControlledCaseSeries)
+options(fftempdir = "c:/fftemp")
+
+rw <- createSimulationRiskWindow(start = 0,
+                                  end = 0,
+                                  addExposedDaysToEnd = TRUE,
+                                  relativeRisks = 2)
+
+settings <- createSccsSimulationSettings(covariateIds = c(1,2),
+                                         simulationRiskWindows = list(rw, rw))
+
+sccsData <- simulateSccsData(10000, settings)
+
+covarSettings <- createCovariateSettings(label = "Exposures of interest",
+                                         includeCovariateIds = c(1,2),
+                                         stratifyById = FALSE,
+                                         start = 0,
+                                         end = 0,
+                                         addExposedDaysToEnd = TRUE,
+                                         splitPoints = 7)
+
+sccsEraData <- createSccsEraData(sccsData,
+                                 naivePeriod = 0,
+                                 firstOutcomeOnly = FALSE,
+                                 covariateSettings = covarSettings)
+
+model <- fitSccsModel(sccsEraData)
+
+summary(model)
diff --git a/tests/testthat/test-eraConstruction.R b/tests/testthat/test-eraConstruction.R
@@ -500,6 +500,70 @@ test_that("Exposure splitting twice", {
   expect_equal(result$covariates$covariateId, c(1000, 1001, 1002))
 })
 
+test_that("Merging exposures (stratifyById=FALSE)", {
+  cases <- data.frame(observationPeriodId = 1,
+                      personId = 1,
+                      observationDays = 100,
+                      ageInDays = 0,
+                      startYear = 2000,
+                      startMonth = 5,
+                      startDay = 1,
+                      censoredDays = 0)
+  eras <- data.frame(eraType = c("hoi", "hei", "hei"),
+                     observationPeriodId = c(1, 1, 1),
+                     conceptId = c(10, 11, 12),
+                     value = c(1, 1, 1),
+                     startDay = c(50, 25, 70),
+                     endDay = c(50, 75, 100))
+  result <- convertToSccsDataWrapper(cases,
+                                     eras,
+                                     covariateSettings = createCovariateSettings(includeCovariateIds = c(11,12),
+                                                                                 stratifyById = FALSE,
+                                                                                 start = 0,
+                                                                                 end = 0,
+                                                                                 addExposedDaysToEnd = TRUE))
+  expect_equal(result$outcomes$rowId, c(0, 1))
+  expect_equal(result$outcomes$stratumId, c(1, 1))
+  expect_equal(result$outcomes$time, c(25, 75))
+  expect_equal(result$outcomes$y, c(0, 1))
+  expect_equal(result$covariates$rowId, c(1))
+  expect_equal(result$covariates$stratumId, c(1))
+  expect_equal(result$covariates$covariateId, c(1000))
+})
+
+
+test_that("Exposure splitting without stratifyById", {
+  cases <- data.frame(observationPeriodId = 1,
+                      personId = 1,
+                      observationDays = 100,
+                      ageInDays = 0,
+                      startYear = 2000,
+                      startMonth = 5,
+                      startDay = 1,
+                      censoredDays = 0)
+  eras <- data.frame(eraType = c("hoi", "hei", "hei"),
+                     observationPeriodId = c(1, 1, 1),
+                     conceptId = c(10, 11, 12),
+                     value = c(1, 1, 1),
+                     startDay = c(50, 25, 70),
+                     endDay = c(50, 75, 100))
+  result <- convertToSccsDataWrapper(cases,
+                                     eras,
+                                     covariateSettings = createCovariateSettings(includeCovariateIds = c(11,12),
+                                                                                 stratifyById = FALSE,
+                                                                                 start = 0,
+                                                                                 end = 0,
+                                                                                 addExposedDaysToEnd = TRUE,
+                                                                                 splitPoints = c(50)))
+  expect_equal(result$outcomes$rowId, c(0, 1, 2))
+  expect_equal(result$outcomes$stratumId, c(1, 1, 1))
+  expect_equal(result$outcomes$time, c(25,51, 24))
+  expect_equal(result$outcomes$y, c(0, 1, 0))
+  expect_equal(result$covariates$rowId, c(1, 2))
+  expect_equal(result$covariates$stratumId, c(1, 1))
+  expect_equal(result$covariates$covariateId, c(1000, 1001))
+})
+
 test_that("Pre-exposure window", {
   cases <- data.frame(observationPeriodId = 1,
                       personId = 1,