Fixed error when failing model fitting caused by new Cyclops versio…

…n. Dropping RISCA dependency

DESCRIPTION

@@ -1,8 +1,8 @@
 Package: CohortMethod
 Type: Package
 Title: New-User Cohort Method with Large Scale Propensity and Outcome Models
-Version: 4.2.2
-Date: 2022-01-21
+Version: 4.2.3
+Date: 2022-08-12
 Authors@R: c(
 	person("Martijn", "Schuemie", , "[email protected]", role = c("aut", "cre")),
 	person("Marc", "Suchard", role = c("aut")),
@@ -55,8 +55,7 @@ Suggests:
 	EmpiricalCalibration,
 	Eunomia,
 	withr,
-	R.utils,
-	RISCA
+	R.utils
 Remotes:
 	ohdsi/FeatureExtraction,
 	ohdsi/Eunomia

NEWS.md

@@ -1,3 +1,15 @@
+CohortMethod 4.2.3
+==================
+
+Changes:
+
+1. Removed `RISCA` from the Suggests list. This package was used for a single unit test, but has a large amount of difficult-to-install dependencies.
+
+Bug fixes:
+
+1. Fixed error when failing model fitting caused by new `Cyclops` version.
+
+
 CohortMethod 4.2.2
 ==================
 

R/OutcomeModels.R

@@ -322,10 +322,8 @@ fitOutcomeModel <- function(population,
             logLikelihoodProfile <- logLikelihoodProfile$value
           }
         }
-        if (fit$return_flag == "ILLCONDITIONED") {
-          status <- "ILL CONDITIONED, CANNOT FIT"
-        } else if (fit$return_flag == "MAX_ITERATIONS") {
-          status <- "REACHED MAXIMUM NUMBER OF ITERATIONS, CANNOT FIT"
+        if (fit$return_flag != "SUCCESS") {
+          status <- fit$return_flag
         } else {
           status <- "OK"
           coefficients <- coef(fit)

tests/testthat/test-kmFunctions.R

@@ -21,15 +21,15 @@ test_that("Weighted Kaplan-Meier", {
 
   expect_equal(sum(weightedKm$s == unweightedKm$s), 0) # None of the values are equal
 
-  if (require("RISCA")) {
-    risca <- RISCA::ipw.survival(lung$time, lung$status - 1, variable = rep(1, length(lung$status)), weights = weight)
-    risca <- risca$table.surv
-
-    matched <- inner_join(risca, data.frame(times = weightedKm$time, survival = weightedKm$s),
-                          by = "times")
-
-    expect_equal(matched$survival.x, matched$survival.y)
-  }
+  # if (require("RISCA")) {
+  #   risca <- RISCA::ipw.survival(lung$time, lung$status - 1, variable = rep(1, length(lung$status)), weights = weight)
+  #   risca <- risca$table.surv
+  #
+  #   matched <- inner_join(risca, data.frame(times = weightedKm$time, survival = weightedKm$s),
+  #                         by = "times")
+  #
+  #   expect_equal(matched$survival.x, matched$survival.y)
+  # }
 })