R/RcppExports.R

In icd: Comorbidity Calculations and Tools for ICD-9 and ICD-10 Codes

# Generated by using Rcpp::compileAttributes() -> do not edit by hand
# Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393

#' Convert \code{mjr} and \code{mnr} vectors to single code
#' @template mjr
#' @template mnr
#' @template isShort
#' @return Character vector
#' @keywords internal manip
icd9MajMinToCode <- function(mjr, mnr, isShort) {
    .Call(`_icd_icd9MajMinToCode`, mjr, mnr, isShort)
}

icd9MajMinToShort <- function(mjr, mnr) {
    .Call(`_icd_icd9MajMinToShort`, mjr, mnr)
}

icd9MajMinToDecimal <- function(mjr, mnr) {
    .Call(`_icd_icd9MajMinToDecimal`, mjr, mnr)
}

#' Set ICD short-form diagnosis code attribute
#'
#' Doing this in an R function doesn't work for 'void' equivalent, and does a
#' copy if the updated object is returned.
#' @examples
#' j <- "100"
#' attr(j, "icd_short_diag") <- TRUE
#' j
#' attr(j, "icd_short_diag") <- FALSE
#' j
#' icd:::attr_decimal_diag(j)
#' as.decimal_diag(j)
#' # if pryr is installed, use address and refs to see what is going on
#' @keywords internal attribute
attr_decimal_diag <- function(x, value = TRUE) {
    invisible(.Call(`_icd_setDecimalDiag`, x, value))
}

#' Set short diagnosis flag in C++
#' @param x Any R object
#' @param value \code{TRUE} or \code{FALSE}
#' @keywords internal attribute
attr_short_diag <- function(x, value = TRUE) {
    invisible(.Call(`_icd_setShortDiag`, x, value))
}

categorize_rcpp <- function() {
    .Call(`_icd_categorize_rcpp`)
}

icd10_children_defined_rcpp <- function(x, lookup, nc, warn = TRUE) {
    .Call(`_icd_icd10ChildrenDefined`, x, lookup, nc, warn)
}

#' @title Internal function to simplify a comorbidity map by only including
#'   codes which are parents, or identical to, a given list of codes.
#' @description Specifically, this is useful for ICD-10 codes where there are a
#' huge number of possible codes, but we do not want to make a comorbidity map
#' with such a large number of codes in it.
#' @param x Character vector (not factor)
#' @template mapping
#' @template visit_name
#' @template icd_name
#' @seealso \url{https://github.com/s-u/fastmatch/blob/master/src/fastmatch.c}
#' @examples
#' # one exact match, next cmb parent code, next cmb child code
#' icd10 <- as.icd10(c("I0981", "A520", "I26019"))
#' pts <- data.frame(visit_id = c("a", "b", "c"), icd10)
#' simple_map <- icd:::simplify_map_lex(icd10, icd10_map_ahrq)
#' stopifnot(simple_map$CHF == "I0981")
#' stopifnot(simple_map$PHTN != character(0))
#' stopifnot(simple_map$PVD == "I26019")
#' umap <- icd:::simplify_map_lex(uranium_pathology$icd10, icd10_map_ahrq)
#' head(icd:::categorize_simple(uranium_pathology, icd10_map_ahrq,
#'                       id_name = "case", code_name = "icd10"))
#' head(icd:::categorize_simple(uranium_pathology, umap,
#'                              id_name = "case", code_name = "icd10"))
#' @keywords internal
#' @noRd
simplify_map_lex <- function(pt_codes, map) {
    .Call(`_icd_simplifyMapLexicographic`, pt_codes, map)
}

#' @title Comorbidity calculation as a matrix multiplication
#' @description
#' The problem is that the matrices could be huge: the patient-icd matrix would
#' be millions of patient rows, and ~15000 columns for all AHRQ comorbidities.
#' @details
#' Several ways of reducing the problem: firstly, as with existing code, we can
#' drop any ICD codes from the map which are not in the patient data. With many
#' patients, this will be less effective as the long tail becomes apparent.
#' However, with the (small) Vermont data, we see ~15,000 codes being reduced to
#' 339.
#' @section Sparse matrices:
#' Using sparse matrices is another solution. Building
#' the initial matrix may become a significant part of the calculation, but once
#' done, the solution could be a simple matrix multiplication, which is
#' potentially highly optimized (Eigen, BLAS, GPU, etc.)
#' @section Eigen:
#' Eigen has parallel (non-GPU) optimized sparse row-major *
#' dense matrix. Patients-ICD matrix must be the row-major sparse one, so the
#' dense matrix is then the comorbidity map
#' \url{https://eigen.tuxfamily.org/dox/TopicMultiThreading.html}
#' @keywords internal array algebra
#' @noRd
comorbid_mat_mul_wide_rcpp <- function(data, map, id_name, code_names, validate) {
    .Call(`_icd_comorbidMatMulWide`, data, map, id_name, code_names, validate)
}

icd9PartsToShort <- function(parts) {
    .Call(`_icd_icd9PartsToShort`, parts)
}

icd9PartsToDecimal <- function(parts) {
    .Call(`_icd_icd9PartsToDecimal`, parts)
}

majMinToParts <- function(mjr, mnr) {
    .Call(`_icd_majMinToParts`, mjr, mnr)
}

icd9ShortToParts <- function(icd9Short, mnrEmpty) {
    .Call(`_icd_icd9ShortToParts`, icd9Short, mnrEmpty)
}

icd9DecimalToParts <- function(icd9Decimal, mnrEmpty) {
    .Call(`_icd_icd9DecimalToParts`, icd9Decimal, mnrEmpty)
}

icd9_short_to_decimal_rcpp <- function(x) {
    .Call(`_icd_icd9ShortToDecimal`, x)
}

icd9_decimal_to_short_rcpp <- function(x) {
    .Call(`_icd_icd9DecimalToShort`, x)
}

#' @describeIn get_major Get major part of ICD-9 code, i.e., first three digits
#'   of numeric or \code{V} code, or first four digits of an \code{E} code.
#'   This is the part before the decimal, when a decimal point is used.
#' @keywords internal manip
#' @export
#' @noRd
get_major.icd9 <- function(x, short_code) {
    .Call(`_icd_icd9GetMajor`, x, short_code)
}

icd10_short_to_parts_rcpp <- function(x, mnrEmpty) {
    .Call(`_icd_icd10ShortToParts`, x, mnrEmpty)
}

icd10DecimalToParts <- function(x, mnrEmpty = "") {
    .Call(`_icd_icd10DecimalToParts`, x, mnrEmpty)
}

#' @title Convert integers to strings as quickly as possible
#' @description Have tried R, \code{sprintf} with \CRANpkg{Rcpp} and C++
#'   standard library. Doesn't do bounds checking, but limited by length of
#'   integers.
#' @param x Vector of integers
#' @return Vector of characters
#' @keywords internal manip
#' @noRd
fastIntToStringRcpp <- function(x) {
    .Call(`_icd_fastIntToStringRcpp`, x)
}

guessShortPlusFactorCpp <- function(x_, n = 1000L) {
    .Call(`_icd_guessShortPlusFactorCpp`, x_, n)
}

#' Guess whether codes are \code{short_code} or \code{decimal_code}
#'
#' The goal is to guess whether codes are \code{short_code} or
#' \code{decimal_code} form. Currently condense works, but not with the
#' \code{icd} look-up table currently in use. Of note, validation is a bit
#' different here, since we don't know the type until after we guess. We could
#' look for where both short_code and long are invalid, and otherwise assume
#' valid, even if the bulk are short_code. However, it may be more useful to
#' check validity after the guess.
#' @details Very quick heuristic, ploughs through ten million codes in less
#'   than one second and will stop more quickly if it finds a '.'.
#' @return single logical value, \code{TRUE} if input data are predominantly
#'   \code{short_code} type. If there is some uncertainty, then return
#'   \code{NA}.
#' @keywords internal
guess_short <- function(x_, short_code = NULL, n = 1000L, icd_name = NULL) {
    .Call(`_icd_guessShortCompleteCpp`, x_, short_code, n, icd_name)
}

#' Do elements of vector begin with V, E (or any other character)?
#'
#' Currently returns a vector of \code{bool} which is not thread safe, or
#' particularly fast, although it is memory efficient in the standard
#' implementation. As of \code{icd9} (now known as \code{icd}) version 1.2,
#' this is not called by threaded code, but this could change, so beware! ASCII
#' spaces are trimmed from the start of the string before testing, but no other
#' white space
#' @param sv vector of strings
#' @param x \code{const char*} of choices of first character to match
#' @param invert single logical, if TRUE, negates the condition
#' @keywords internal
#' @noRd
icd9_is_n_rcpp <- function(sv) {
    .Call(`_icd_icd9_is_n_rcpp`, sv)
}

#' @title icd9_is_n_rcpp
#' @keywords internal
#' @noRd
icd9_is_v_rcpp <- function(sv) {
    .Call(`_icd_icd9_is_v_rcpp`, sv)
}

#' @title icd9_is_n_rcpp
#' @keywords internal
#' @noRd
icd9_is_e_rcpp <- function(sv) {
    .Call(`_icd_icd9_is_e_rcpp`, sv)
}

#' Simpler add leading zeroes without converting to parts and back
#' @keywords internal manip
#' @noRd
icd9AddLeadingZeroesMajorSingle <- function(mjr) {
    .Call(`_icd_icd9AddLeadingZeroesMajorSingle`, mjr)
}

icd9AddLeadingZeroesMajorSingleStd <- function(m) {
    .Call(`_icd_icd9AddLeadingZeroesMajorSingleStd`, m)
}

icd9_add_leading_zeroes_major <- function(mjr) {
    .Call(`_icd_icd9AddLeadingZeroesMajor`, mjr)
}

#' @title Add leading zeroes to incomplete ICD-9 codes
#' @description Non-decimal ICD-9 codes with length<5 are often ambiguous. E.g.
#'   100 could be 1.00 10.0 or 100 if coded incorrectly. We must assume 100 is
#'   really 100
#' @param x Character vector of ICD-9 codes
#' @template short_code
#' @return character vector of ICD-9 codes with leading zeroes
#' @keywords internal manip
#' @noRd
icd9_add_leading_zeroes_rcpp <- function(x, short_code) {
    .Call(`_icd_icd9AddLeadingZeroes`, x, short_code)
}

icd9_expand_minor_rcpp <- function(mnr, isE) {
    .Call(`_icd_icd9ExpandMinor`, mnr, isE)
}

icd9_children_short_undefined_rcpp <- function(icd9Short) {
    .Call(`_icd_icd9ChildrenShortUndefined`, icd9Short)
}

icd9_children_short_defined_rcpp <- function(icd9Short, icd9cmReal) {
    .Call(`_icd_icd9ChildrenShortDefined`, icd9Short, icd9cmReal)
}

icd9_children_short_rcpp <- function(icd9Short, icd9cmReal, onlyReal) {
    .Call(`_icd_icd9ChildrenShort`, icd9Short, icd9cmReal, onlyReal)
}

icd9_children_short_unordered_undefined_rcpp <- function(icd9Short) {
    .Call(`_icd_icd9ChildrenShortUnorderedUndefined`, icd9Short)
}

icd9_children_short_unordered_defined_rcpp <- function(icd9Short, icd9cmReal) {
    .Call(`_icd_icd9ChildrenShortUnorderedDefined`, icd9Short, icd9cmReal)
}

icd9_children_short_unordered_rcpp <- function(icd9Short, icd9cmReal, onlyReal) {
    .Call(`_icd_icd9ChildrenShortUnordered`, icd9Short, icd9cmReal, onlyReal)
}

icd9_children_decimal_rcpp <- function(icd9Decimal, icd9cmReal, onlyReal) {
    .Call(`_icd_icd9ChildrenDecimal`, icd9Decimal, icd9cmReal, onlyReal)
}

icd9_children_decimal_unordered_rcpp <- function(icd9Decimal, icd9cmReal, onlyReal) {
    .Call(`_icd_icd9ChildrenDecimalUnordered`, icd9Decimal, icd9cmReal, onlyReal)
}

icd9_children_decimal_unordered_undefined_rcpp <- function(icd9Decimal) {
    .Call(`_icd_icd9ChildrenDecimalUnorderedUndefined`, icd9Decimal)
}

icd9_children_decimal_unordered_defined_rcpp <- function(icd9Decimal, icd9cmReal) {
    .Call(`_icd_icd9ChildrenDecimalUnorderedDefined`, icd9Decimal, icd9cmReal)
}

icd9_children_rcpp <- function(icd9, isShort, icd9cmReal, onlyReal) {
    .Call(`_icd_icd9Children`, icd9, isShort, icd9cmReal, onlyReal)
}

#' @title Factor without sorting \CRANpkg{Rcpp} implementation
#' @description Requiring character vector inputs only, no argument checking.
#' @keywords internal manip
#' @noRd
factor_nosort_rcpp_worker <- function(x, levels, na_rm) {
    .Call(`_icd_factorNoSort`, x, levels, na_rm)
}

#' @title Re-generate a factor with new levels, without doing string matching
#' @description This is called by an R wrapper. There is an \code{na.rm}
#'   version, too. Some work simply to mirror behavior of \code{base::factor},
#'   e.g. when a level is not available, but NA level is available, NA is
#'   inserted into the integer vector, not an index to the NA level.
#' @keywords internal manip
#' @noRd
refactor_worker <- function(x, new_levels, exclude_na, validate) {
    .Call(`_icd_refactor`, x, new_levels, exclude_na, validate)
}

#' @describeIn refactor_worker Drop all \code{NA} values from levels and values
#' @keywords internal
#' @noRd
refactor_narm_worker <- function(x, new_levels, validate) {
    .Call(`_icd_refactor_narm`, x, new_levels, validate)
}

#' @title Check a factor structure is valid
#' @keywords internal
#' @noRd
factor_is_valid <- function(f) {
    .Call(`_icd_factorIsValid`, f)
}

icd9_compare_rcpp <- function(a, b) {
    .Call(`_icd_icd9Compare`, a, b)
}

icd9_compare_vector_rcpp <- function(x, y) {
    .Call(`_icd_icd9CompareVector`, x, y)
}

icd9_sort_rcpp <- function(x) {
    .Call(`_icd_icd9Sort`, x)
}

icd9_order_rcpp <- function(x) {
    .Call(`_icd_icd9Order`, x)
}

icd10cm_compare_c <- function(xstr, ystr) {
    .Call(`_icd_icd10cmCompareC`, xstr, ystr)
}

icd10cm_compare_rcpp <- function(x, y) {
    .Call(`_icd_icd10cmCompare`, x, y)
}

icd10cm_compare_vector_rcpp <- function(x, y) {
    .Call(`_icd_icd10cmCompareVector`, x, y)
}

icd10cm_sort_rcpp <- function(x) {
    .Call(`_icd_icd10cmSort`, x)
}

#' @title Order ICD-10-CM codes
#' @description Currently required for C7A, C7B (which fall after C80 nad before C81), and
#'   D3A, which falls after D48. C4A M1A Z3A are also problems within
#'   sub-chapters.
#' https://www.icd10data.com/ICD10CM/Codes/C00-D49
#' https://www.icd10data.com/ICD10CM/Codes/C00-D49/C43-C44
#' https://www.icd10data.com/ICD10CM/Codes/M00-M99/M05-M14
#' https://www.icd10data.com/ICD10CM/Codes/Z00-Z99/Z30-Z39
#' @keywords internal
#' @noRd
icd10cm_order_rcpp <- function(x) {
    .Call(`_icd_icd10cmOrder`, x)
}

trimLeftCpp <- function(s) {
    .Call(`_icd_trimLeftCpp`, s)
}

strimCpp <- function(s) {
    .Call(`_icd_strimCpp`, s)
}

trimCpp <- function(sv) {
    .Call(`_icd_trimCpp`, sv)
}

#' @title Faster match
#' @keywords internal
#' @noRd
match_rcpp <- function(x, table) {
    .Call(`_icd_matchFast`, x, table)
}

#' Use faster matching for %in% equivalent
#' @keywords internal
#' @noRd
fin <- function(x, table) {
    .Call(`_icd_inFast`, x, table)
}

#' Get some information about how this DLL was compiled
#' @keywords internal
#' @noRd
build_info <- function() {
    invisible(.Call(`_icd_build_info`))
}