tests/test-comorbidities.R

In medicalcoder: A Unified and Longitudinally Aware Framework for ICD-Based Comorbidity Assessment

source('utilities.R')
################################################################################
library(medicalcoder)
set.seed(42)

################################################################################
# verify an error will be thrown if lenght(id.vars) < 2 and flag.method =
# "cumulative"

rtn <- # length(id.vars) = 0
  tryCatchError(
    comorbidities(
      data = mdcr,
      icd.codes = "code",
      poa = 1L,
      flag.method = 'cumulative',
      method = "pccc_v3.1"
    )
  )
stopifnot(inherits(rtn, "error"))

rtn <- # length(id.vars) = 1
  tryCatchError(
    comorbidities(
      data = mdcr,
      id.vars = "patid",
      icd.codes = "code",
      poa = 1L,
      flag.method = 'cumulative',
      method = "pccc_v3.1"
    )
  )
stopifnot(inherits(rtn, "error"))


################################################################################
# verify errors are thrown if a "protected" name is used for the id.vars,
# poa.var, or primarydx.var
mdcr2 <- mdcr
mdcr2[["condition"]] <- 1L

x <-
  tryCatchError(
    comorbidities(
      data = mdcr2,
      icd.codes = "code",
      id.vars = c("patid", "condition"),
      method = "pccc_v3.1"
    )
  )
stopifnot(inherits(x, "error"))

x <-
  tryCatchError(
    comorbidities(
      data = mdcr2,
      icd.codes = "code",
      id.vars = c("condition"),
      method = "pccc_v3.1"
    )
  )
stopifnot(inherits(x, "error"))

x <-
  tryCatchError(
    comorbidities(
      data = mdcr2,
      icd.codes = "code",
      poa.vars = c("condition"),
      method = "pccc_v3.1"
    )
  )
stopifnot(inherits(x, "error"))

x <-
  tryCatchError(
    comorbidities(
      data = mdcr2,
      icd.codes = "code",
      primarydx.var = "condition",
      method = "elixhauser_ahrq2025"
    )
  )
stopifnot(inherits(x, "error"))

################################################################################
# verify errors are thrown when icdv.var, dx.var, poa.var, or primarydx.var are
# non-numeric
mdcr3 <- mdcr
mdcr3[["icdv_chr"]] <- as.character(mdcr3[["icdv"]])
mdcr3[["dx_chr"]] <- as.character(mdcr3[["dx"]])
mdcr3[["poa_chr"]] <- as.character(rep(1L, nrow(mdcr3)))
mdcr3[["primarydx_chr"]] <- as.character(rep(0L, nrow(mdcr3)))

x <-
  tryCatchError(
    comorbidities(
      data = mdcr3,
      id.vars = "patid",
      icd.codes = "code",
      icdv.var = "icdv_chr",
      dx.var = "dx",
      poa = 1L,
      method = "pccc_v3.1"
    )
  )
stopifnot(
  inherits(x, "error"),
  grepl(
    "Column .*icdv_chr.* must be numeric \\(9/10/NA\\) when supplied as icdv\\.var\\.",
    gsub("['\"`\\p{Pi}\\p{Pf}]", "", x[["message"]], perl = TRUE)
  )
)

x <-
  tryCatchError(
    comorbidities(
      data = mdcr3,
      id.vars = "patid",
      icd.codes = "code",
      icdv.var = "icdv",
      dx.var = "dx_chr",
      poa = 1L,
      method = "pccc_v3.1"
    )
  )
stopifnot(
  inherits(x, "error"),
  grepl(
    "Column .*dx_chr.* must be numeric \\(0/1/NA\\) when supplied as dx\\.var\\.",
    gsub("['\"`\\p{Pi}\\p{Pf}]", "", x[["message"]], perl = TRUE)
  )
)

x <-
  tryCatchError(
    comorbidities(
      data = mdcr3,
      id.vars = "patid",
      icd.codes = "code",
      icdv.var = "icdv",
      dx.var = "dx",
      poa.var = "poa_chr",
      method = "pccc_v3.1"
    )
  )
stopifnot(
  inherits(x, "error"),
  grepl(
    "Column .*poa_chr.* must be numeric \\(0/1/NA\\) when supplied as poa\\.var\\.",
    gsub("['\"`\\p{Pi}\\p{Pf}]", "", x[["message"]], perl = TRUE)
  )
)

x <-
  tryCatchError(
    comorbidities(
      data = mdcr3,
      id.vars = "patid",
      icd.codes = "code",
      icdv.var = "icdv",
      dx.var = "dx",
      poa = 1L,
      primarydx.var = "primarydx_chr",
      method = "elixhauser_ahrq2025"
    )
  )
stopifnot(
  inherits(x, "error"),
  grepl(
    "Column .*primarydx_chr.* must be numeric \\(0/1/NA\\) when supplied as primarydx\\.var\\.",
    gsub("['\"`\\p{Pi}\\p{Pf}]", "", x[["message"]], perl = TRUE)
  )
)


################################################################################
# Test: check_and_set_*
#
# The check_and_set_* are non-exported methods.  We test them here with calls to
# comorbidities() so that we can capture these test with covr

# Verify these methods are non-exported
stopifnot(!("check_and_set_id_vars" %in% getNamespaceExports("medicalcoder")))

# The following data frames are used to test check_and_set_id_vars.
# `..medicalcoder_id..` is the initial name used in the check and set when
# creating an id column.  it needs to persist in the output if provided as an
# id.
DF0 <- data.frame(pid = NA, code = "A00")
DF1 <- data.frame(medicalcoder_id = NA, code = "A00")
DF2 <- data.frame(..medicalcoder_id.. = NA, code = "A00")

# verify that the constuction of a id.vars within the function works as
# expected.
OUT0 <- comorbidities(data = DF0, icd.codes = "code", method = "pccc_v3.0", poa = 1)
OUT1 <- comorbidities(data = DF1, icd.codes = "code", method = "pccc_v3.0", poa = 1)
OUT2 <- comorbidities(data = DF2, icd.codes = "code", method = "pccc_v3.0", poa = 1)

expected_names <-
  c(
    "congeni_genetic_dxpr_only",
    "congeni_genetic_tech_only",
    "congeni_genetic_dxpr_and_tech",
    "congeni_genetic_dxpr_or_tech",

    "cvd_dxpr_only",
    "cvd_tech_only",
    "cvd_dxpr_and_tech",
    "cvd_dxpr_or_tech",

    "gi_dxpr_only",
    "gi_tech_only",
    "gi_dxpr_and_tech",
    "gi_dxpr_or_tech",

    "hemato_immu_dxpr_only",
    "hemato_immu_tech_only",
    "hemato_immu_dxpr_and_tech",
    "hemato_immu_dxpr_or_tech",

    "malignancy_dxpr_only",
    "malignancy_tech_only",
    "malignancy_dxpr_and_tech",
    "malignancy_dxpr_or_tech",

    "metabolic_dxpr_only",
    "metabolic_tech_only",
    "metabolic_dxpr_and_tech",
    "metabolic_dxpr_or_tech",

    "misc_dxpr_only",
    "misc_tech_only",
    "misc_dxpr_and_tech",
    "misc_dxpr_or_tech",

    "neonatal_dxpr_only",
    "neonatal_tech_only",
    "neonatal_dxpr_and_tech",
    "neonatal_dxpr_or_tech",

    "neuromusc_dxpr_only",
    "neuromusc_tech_only",
    "neuromusc_dxpr_and_tech",
    "neuromusc_dxpr_or_tech",

    "renal_dxpr_only",
    "renal_tech_only",
    "renal_dxpr_and_tech",
    "renal_dxpr_or_tech",

    "respiratory_dxpr_only",
    "respiratory_tech_only",
    "respiratory_dxpr_and_tech",
    "respiratory_dxpr_or_tech",

    "any_tech_dep",
    "any_transplant",

    "num_cmrb",
    "cmrb_flag"
  )

stopifnot(identical(names(OUT0), expected_names))
stopifnot(identical(names(OUT1), expected_names))
stopifnot(identical(names(OUT2), expected_names))

OUT0 <- comorbidities(data = DF0, id.vars = "pid", icd.codes = "code", method = "pccc_v3.0", poa = 1)
OUT1 <- comorbidities(data = DF1, id.vars = "medicalcoder_id", icd.codes = "code", method = "pccc_v3.0", poa = 1)
OUT2 <- comorbidities(data = DF2, id.vars = "..medicalcoder_id..", icd.codes = "code", method = "pccc_v3.0", poa = 1)

stopifnot(identical(names(OUT0), c("pid", expected_names)))
stopifnot(identical(names(OUT1), c("medicalcoder_id", expected_names)))
stopifnot(identical(names(OUT2), c("..medicalcoder_id..", expected_names)))

################################################################################
# Check for "protected" names in id.vars.
#
# During development I had been using id.vars such as:
#
#   id.vars = c("patid", "icd_code")
#
# so I could look at which codes in a patient record where flagging.
#
# When I tried the following
#
#   id.vars = c("patid", "icd_code", "icdv")
#   icdv.var = NULL
#   icdv = NULL
#
# I'd get an error because the "icdv" name is being used in the lookup tables and
# gets drop in the methods and the joins in the code created a icdv.x and icdv.y
# variable.  The code was updated so that the suffixes would be c("", ".y") to
# fix this issue.
#
# for 0.0.0.9038 the following calls to comorbidities would error with the
# following message:
#
#    Error in `[.data.frame`(x, r, vars, drop = drop) :
#      undefined columns selected
#
# Expect that the following calls should work without error
#
# between 0.0.0.9044 and 0.0.0.9045 it was determined that there are some names
# that should not be used in the id.vars, poa.var, or the primarydx.var.  Tests
# for those are above.  The tests below would have passed for 0.0.0.9039 -
# 0.0.0.9044, but will error for 0.0.0.9045 with a useful error message.
mdcr$full_code <- "just a test"
mdcr$icd_code <- mdcr$code

args <- list(data = mdcr, icd.code = "icd_code", method = "pccc_v3.0", poa = 1)

out1 <- tryCatchError(do.call(comorbidities, c(args, list(id.vars = c("patid", "full_code")))))
out2 <- tryCatchError(do.call(comorbidities, c(args, list(id.vars = c("patid", "icdv")))))
out3 <- tryCatchError(do.call(comorbidities, c(args, list(id.vars = c("patid", "dx")))))
out4 <- tryCatchError(do.call(comorbidities, c(args, list(id.vars = c("patid", "code")))))
stopifnot(
  inherits(out1, "error"),
  inherits(out2, "error"),
  inherits(out3, "error"),
  inherits(out4, "error")
)

################################################################################
# when a primarydx.var was passed to comorbidities when not needed an error was
# thrown.  https://github.com/dewittpe/medicalcoder/issues/16
#
# This has been corrected to be a warning
x <-
  tryCatchWarning(
    comorbidities(
      data = mdcr,
      id.var = "patid",
      method = "charlson_quan2005",
      icd.codes = "code",
      poa = 1
    )
  )
stopifnot("warning for missing primarydx" = inherits(x, "warning"))

################################################################################
# Subconditions are only applicable to PCCC, so a warning should be given when
# subconditions = TRUE for any other method
args <- list(
  data = mdcr[1:10, ],
  icd.codes = "icd_code",
  icdv.var = "icdv",
  dx.var = "dx",
  poa = 1,
  subconditions = TRUE
  )
ms <- medicalcoder:::comorbidities_methods()
ms <- ms[!startsWith(ms, "pccc")]
for (m in ms) {
  x <- tryCatchWarning(do.call(comorbidities, c(args, list(method = m))))
  z <- inherits(x, "warning")
  if (!z) {
    stop(sprintf("no warning given for subconditions = TRUE with method = '%s'", m))
  }
  if (x$message != "subconditions only implemented for PCCC") {
    stop(sprintf("unexpected warning message for subcondtions = TRUE with method = '%s'", m))
  }
}

################################################################################
#                                 End of File                                  #
################################################################################