R Under development (unstable) (2025-11-21 r89046 ucrt) -- "Unsuffered Consequences"
Copyright (C) 2025 The R Foundation for Statistical Computing
Platform: x86_64-w64-mingw32/x64

R is free software and comes with ABSOLUTELY NO WARRANTY.
You are welcome to redistribute it under certain conditions.
Type 'license()' or 'licence()' for distribution details.

R is a collaborative project with many contributors.
Type 'contributors()' for more information and
'citation()' on how to cite R or R packages in publications.

Type 'demo()' for some demos, 'help()' for on-line help, or
'help.start()' for an HTML browser interface to help.
Type 'q()' to quit R.

> source('utilities.R')
> ################################################################################
> # Tests for summarizing Charlson comorbidities
> library(medicalcoder)
> 
> ################################################################################
> # Prepare input with an age variable to exercise age scoring logic
> mdcr$age <- as.integer(substr(as.character(mdcr$patid), 1, 2))
> 
> charlson <- comorbidities(
+   data       = mdcr,
+   id.vars    = "patid",
+   icdv.var   = "icdv",
+   icd.codes  = "code",
+   dx.var     = "dx",
+   method     = "charlson_quan2011",
+   flag.method = "current",
+   poa        = 1L,
+   primarydx  = 0L,
+   age.var    = "age"
+ )
> 
> summary_current <- summary(charlson)
> 
> stopifnot(
+   is.list(summary_current),
+   identical(names(summary_current), c("conditions", "age_summary", "index_summary")),
+   is.data.frame(summary_current$conditions),
+   identical(
+     names(summary_current$conditions),
+     c("condition_description", "condition", "count", "percent")
+   ),
+   is.character(summary_current$conditions$condition_description),
+   is.character(summary_current$conditions$condition),
+   is.numeric(summary_current$conditions$count),
+   is.numeric(summary_current$conditions$percent),
+   all(summary_current$conditions$count >= 0),
+   all(summary_current$conditions$percent >= 0),
+   all(summary_current$conditions$percent <= 100)
+ )
> 
> ################################################################################
> # Conditions summary matches direct aggregations
> aidshiv_count <- summary_current$conditions[
+   !is.na(summary_current$conditions$condition) &
+   summary_current$conditions$condition == "aidshiv",
+   "count"
+ ]
> copd_count <- summary_current$conditions[
+   !is.na(summary_current$conditions$condition) &
+   summary_current$conditions$condition == "copd",
+   "count"
+ ]
> 
> stopifnot(
+   aidshiv_count == sum(charlson$aidshiv),
+   copd_count   == sum(charlson$copd)
+ )
> 
> num_ge_1 <- summary_current$conditions[
+   is.na(summary_current$conditions$condition) &
+   summary_current$conditions$condition_description == ">= 1",
+   "count"
+ ]
> num_ge_2 <- summary_current$conditions[
+   is.na(summary_current$conditions$condition) &
+   summary_current$conditions$condition_description == ">= 2",
+   "count"
+ ]
> 
> stopifnot(
+   num_ge_1 == sum(charlson$num_cmrb >= 1),
+   num_ge_2 == sum(charlson$num_cmrb >= 2)
+ )
> 
> ################################################################################
> # Age and index summaries align with expected calculations
> expected_age_summary <-
+   merge(
+     x = stats::setNames(as.data.frame(table(charlson$age_score, useNA = "always"), stringsAsFactors = FALSE), c("age_score", "count")),
+     y = stats::setNames(as.data.frame(100 * prop.table(table(charlson$age_score, useNA = "always")), stringsAsFactors = FALSE), c("age_score", "percent")),
+     by = "age_score"
+   )
> 
> stopifnot(identical(summary_current$age_summary, expected_age_summary))
> 
> expected_index_summary <-
+   data.frame(
+     min    = min(charlson$cci),
+     q1     = stats::quantile(charlson$cci, prob = 0.25),
+     median = stats::median(charlson$cci),
+     q3     = stats::quantile(charlson$cci, prob = 0.75),
+     max    = max(charlson$cci),
+     row.names = NULL
+   )
> 
> stopifnot(identical(summary_current$index_summary, expected_index_summary))
> 
> ################################################################################
> # A non-current flag.method generates a warning but still returns the summary
> charlson_cumulative <- charlson
> attr(charlson_cumulative, "flag.method") <- "cumulative"
> 
> warn_obj <- tryCatchWarning(summary(charlson_cumulative))
> 
> stopifnot(
+   inherits(warn_obj, "warning"),
+   identical(
+     conditionMessage(warn_obj),
+     "Logic for charlson summary table has been implemented for flag.method = 'current'.  Using this function for flag.method = 'cumulative' may not provide a meaningful summary."
+   )
+ )
> 
> summary_cumulative <- suppressWarnings(summary(charlson_cumulative))
> 
> stopifnot(
+   identical(summary_cumulative$conditions, summary_current$conditions),
+   identical(summary_cumulative$age_summary, summary_current$age_summary),
+   identical(summary_cumulative$index_summary, summary_current$index_summary)
+ )
> 
> ################################################################################
> #                                 End of File                                  #
> ################################################################################
> 
> proc.time()
   user  system elapsed 
   3.43    0.20    3.60