From a7a805e9b71f1e77c372c4b5ba7f623ff6cdea6d Mon Sep 17 00:00:00 2001
From: schuemie <schuemie@ohdsi.org>
Date: Tue, 5 Nov 2024 13:01:09 +0100
Subject: [PATCH] Making rare outcome diagnostic more consistent with other
 diagnostics

---
 NAMESPACE                                     |  2 +-
 R/Diagnostics.R                               | 20 +++++++++++--------
 ...lated.Rd => checkRareOutcomeAssumption.Rd} | 13 ++++++------
 3 files changed, 20 insertions(+), 15 deletions(-)
 rename man/{isRareOutcomeAssumptionViolated.Rd => checkRareOutcomeAssumption.Rd} (78%)

diff --git a/NAMESPACE b/NAMESPACE
index 5198649..7659eda 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -5,6 +5,7 @@ S3method(confint,SccsModel)
 S3method(print,SccsModel)
 S3method(print,summary.SccsData)
 S3method(print,summary.SccsIntervalData)
+export(checkRareOutcomeAssumption)
 export(computeEventDependentObservation)
 export(computeExposureChange)
 export(computeExposureStability)
@@ -47,7 +48,6 @@ export(getResultsSummary)
 export(hasAgeEffect)
 export(hasCalendarTimeEffect)
 export(hasSeasonality)
-export(isRareOutcomeAssumptionViolated)
 export(isSccsData)
 export(isSccsIntervalData)
 export(loadExposuresOutcomeList)
diff --git a/R/Diagnostics.R b/R/Diagnostics.R
index 8658d10..e3851ac 100644
--- a/R/Diagnostics.R
+++ b/R/Diagnostics.R
@@ -744,14 +744,15 @@ computeExposureStability <- function(studyPopulation,
 #' Modelling Guide with R, CRC Press, 2018
 #'
 #' @return
-#' A logical value, which is TRUE if the rare outcome assumption is violated. The assumption is
-#' violated when restricting to first outcome only and the prevalence exceeds the pre-defined
-#' threshold.
+#' A tibble with one row and three columns: `outcomeProportion` indicates the proportion of people
+#' having the outcome at least once. `firstOutcomeOnly` indicated whether the analysis was restricted
+#' to the first outcome only. `rare` is TRUE if the rare outcome assumption is met, or the analysis
+#' was not restricted to the first outcome.
 #'
 #' @export
-isRareOutcomeAssumptionViolated <- function(studyPopulation,
-                                            firstOutcomeOnly = NULL,
-                                            maxPrevalence = 0.1) {
+checkRareOutcomeAssumption <- function(studyPopulation,
+                                       firstOutcomeOnly = NULL,
+                                       maxPrevalence = 0.1) {
   errorMessages <- checkmate::makeAssertCollection()
   checkmate::assertList(studyPopulation, min.len = 1, add = errorMessages)
   checkmate::assertLogical(firstOutcomeOnly, len = 1, null.ok = TRUE, add = errorMessages)
@@ -762,8 +763,11 @@ isRareOutcomeAssumptionViolated <- function(studyPopulation,
     firstOutcomeOnly <- prevalence$definitelyFirstOutcomeOnly | prevalence$probablyFirstOutcomeOnly
   }
   if (firstOutcomeOnly) {
-    return(prevalence$outcomeProportion > maxPrevalence)
+    rare <- prevalence$outcomeProportion <= maxPrevalence
   } else {
-    return(FALSE)
+    rare <- TRUE
   }
+  return(tibble(outcomeProportion = prevalence$outcomeProportion,
+                firstOutcomeOnly = firstOutcomeOnly,
+                rare = rare))
 }
diff --git a/man/isRareOutcomeAssumptionViolated.Rd b/man/checkRareOutcomeAssumption.Rd
similarity index 78%
rename from man/isRareOutcomeAssumptionViolated.Rd
rename to man/checkRareOutcomeAssumption.Rd
index 23df137..1b12c24 100644
--- a/man/isRareOutcomeAssumptionViolated.Rd
+++ b/man/checkRareOutcomeAssumption.Rd
@@ -1,10 +1,10 @@
 % Generated by roxygen2: do not edit by hand
 % Please edit documentation in R/Diagnostics.R
-\name{isRareOutcomeAssumptionViolated}
-\alias{isRareOutcomeAssumptionViolated}
+\name{checkRareOutcomeAssumption}
+\alias{checkRareOutcomeAssumption}
 \title{Check if rare outcome assumption is violated}
 \usage{
-isRareOutcomeAssumptionViolated(
+checkRareOutcomeAssumption(
   studyPopulation,
   firstOutcomeOnly = NULL,
   maxPrevalence = 0.1
@@ -22,9 +22,10 @@ outcome when pulling the data from the server.}
 allowed when restricting to first outcome only.}
 }
 \value{
-A logical value, which is TRUE if the rare outcome assumption is violated. The assumption is
-violated when restricting to first outcome only and the prevalence exceeds the pre-defined
-threshold.
+A tibble with one row and three columns: \code{outcomeProportion} indicates the proportion of people
+having the outcome at least once. \code{firstOutcomeOnly} indicated whether the analysis was restricted
+to the first outcome only. \code{rare} is TRUE if the rare outcome assumption is met, or the analysis
+was not restricted to the first outcome.
 }
 \description{
 Check if rare outcome assumption is violated