Nothing
#' show the difference between two comorbidity mappings
#'
#' Compares two comorbidity to ICD code mappings. The results are returned
#' invisibly as a list. Only those comorbidities with (case sensitive)
#' overlapping names are compared.
#' @param x list of character vectors
#' @param y list of character vectors
#' @param all_names character vector of the comorbidity names
#' @param x_names character vector of the comorbidity names from \code{x} to
#' compare
#' @param y_names character vector of the comorbidity names from \code{y} to
#' compare
#' @param show single logical value. The default is \code{TRUE} which causes a
#' report to be printed.
#' @param explain single logical value. The default is \code{TRUE} which means
#' the differing codes are attempted to be reduced to their parent codes, in
#' order to give a more succinct summary.
#' @examples
#' # compare CHF for ICD-10 mappings from Elixhauser and AHRQ
#' diff_comorbid(icd10_map_elix, icd10_map_ahrq, show = FALSE)[["CHF"]]
#' \dontrun{
#' # default is to show the results in a human readable manner:
#' diff_result <- diff_comorbid(icd9_map_elix, icd9_map_ahrq)[["CHF"]]
#' # show differences for
#' # give full report on all comorbidities for these mappings
#' diff_result <- diff_comorbid(icd9_map_elix, icd9_map_ahrq, show = FALSE)
#'
#' # the following outputs a summary to the console:
#' diff_comorbid(icd9_map_elix, icd9_map_ahrq)
#' }
#' @return A list, each item of which is another list containing the
#' intersections and both asymmetric differences.
#' @export
diff_comorbid <- function(x, y, all_names = NULL, x_names = NULL,
y_names = NULL, show = TRUE, explain = TRUE) {
UseMethod("diff_comorbid")
}
#' @describeIn diff_comorbid Show difference between comorbidity maps with
#' ICD-9 codes
#' @export
diff_comorbid.list <- function(x, y, all_names = NULL, x_names = NULL,
y_names = NULL, show = TRUE, explain = TRUE) {
assert_list(x,
min.len = 1, any.missing = FALSE,
types = c("character"), names = "unique"
)
assert_list(y,
min.len = 1, any.missing = FALSE,
types = c("character"), names = "unique"
)
assert_flag(show)
assert_flag(explain)
stopifnot(all(x_names %in% names(x)), all(y_names %in% names(y)))
if (!is.null(names) && (!is.null(x_names) | !is.null(y_names))) {
stop("if 'all_names' is specified, 'x_names' and 'y_names' should not be")
}
if (!is.null(all_names)) {
x_names <- y_names <- all_names
}
if (is.null(x_names)) x_names <- names(x)
if (is.null(y_names)) y_names <- names(y)
common.names <- intersect(x_names, y_names)
x.title <- deparse(substitute(x))
y.title <- deparse(substitute(y))
out <- list()
for (n in common.names) {
both <- intersect(x[[n]], y[[n]])
only.x <- setdiff(x[[n]], y[[n]])
only.y <- setdiff(y[[n]], x[[n]])
out[[n]] <- list(both = both, only.x = only.x, only.y = only.y)
if (show) {
cat(sprintf("Comorbidity %s: ", n))
if (length(both) == 0) {
cat("no common codes. ")
}
if (length(only.x) == 0 && length(only.y) == 0) {
cat("match.\n")
next
}
if (length(only.x) > 0) {
cat(sprintf(
"\n%s has %d codes not in %s. First few are: ",
x.title, length(only.x), y.title
))
lapply(
explain_code(only.x,
condense = TRUE,
brief = TRUE, warn = FALSE
)[1:5],
function(s) if (!is.na(s)) cat(sprintf("'%s' ", s))
)
}
if (length(only.y) > 0) {
cat(sprintf(
"\n%s has %d codes not in %s. First few are: ",
y.title, length(only.y), x.title
))
lapply(
explain_code(only.y,
condense = TRUE,
brief = TRUE, warn = FALSE
)[1:5],
function(s) if (!is.na(s)) cat(sprintf("'%s' ", s))
)
}
cat("\n")
}
}
if (show) {
cmb_only_x <- setdiff(x_names, y_names)
cmb_only_y <- setdiff(y_names, x_names)
if (length(cmb_only_x) > 0) {
cat(sprintf("Comorbidities only defined in %s are: ", x.title))
lapply(cmb_only_x, function(s) cat(sprintf("%s ", s)))
cat("\n")
}
if (length(cmb_only_y) > 0) {
cat(sprintf("Comorbidities only defined in %s are: ", y.title))
lapply(cmb_only_y, function(s) cat(sprintf("%s ", s)))
cat("\n")
}
}
invisible(out)
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.