Skip to contents

build a Markov probability model from multi-age prediction models To implement this, all patients at a given age will be binned according to their model score (using quantiles). Each bin is assigned a state, and we are computing the probability for traversing from each state to the next model state Patients with missing score are also included for this model to reflect actual population numbers

Usage

mldpEHR.mortality_markov(
  models,
  outcome,
  step,
  qbins = seq(0, 1, by = 0.05),
  required_conditions = "id==id"
)

Arguments

models
  • list of prediction models (output of mldpEHR.cv_train_stitch_outcome)

outcome
  • time from oldest model (first) to target outcome

step
  • time between prediction models

qbins
  • quantile bin size of prediction score for which the markov model will define a state

required_conditions
  • any filter to apply to the patients to filter out from model computation, for example limiting the time window

Value

a list of markov models (per age), each is a list with the following members:

  • model - matrix containing the probability for each quantile(score) bin to reach each of the target_classes provided in the oldest model.

  • local.model - data.frame containing the probability for each quantile(score) bin to reach each of the quantile(score) bins of the next model by age.

  • qbins - bins

  • target - data frame containing the target bin for this age model (to be used as outcome for the younger age model)

Examples


library(dplyr)
library(ggplot2)
N <- 10000
patients <- purrr::map(0:5, ~ data.frame(
    id = 1:N,
    sex = rep(c(1, 2), N / 2),
    age = 80 - .x * 5,
    death = c(rep(NA, 0.2 * N), rep(82, 0.8 * N)),
    followup = .x * 5 + 5
)) %>%
    setNames(seq(80, by = -5, length.out = 6))
features <- purrr::map(0:5, ~ data.frame(
    id = 1:N,
    a = c(rnorm(0.2 * N), rnorm(0.8 * N, mean = 2, sd = 0.5))
)) %>% setNames(seq(80, by = -5, length.out = 6))
predictors <- mldpEHR.mortality_multi_age_predictors(patients, features, 5, 3, q_thresh = 0.2)
#> 

#>   Training [-----------------------------] 0/3 (  0%) in  0s
#> 

#>   Training [=========>-------------------] 1/3 ( 33%) in  0s
#> 

#>   Training [==================>----------] 2/3 ( 67%) in  2s
#> 

#>   Training [=============================] 3/3 (100%) in  3s
#> 
#> 

#>   Training [-----------------------------] 0/3 (  0%) in  0s
#> 

#>   Training [=========>-------------------] 1/3 ( 33%) in  0s
#> 

#>   Training [==================>----------] 2/3 ( 67%) in  2s
#> 

#>   Training [=============================] 3/3 (100%) in  3s
#> 
#> 

#>   Training [-----------------------------] 0/3 (  0%) in  0s
#> 

#>   Training [=========>-------------------] 1/3 ( 33%) in  0s
#> 

#>   Training [==================>----------] 2/3 ( 67%) in  2s
#> 

#>   Training [=============================] 3/3 (100%) in  3s
#> 
#> 

#>   Training [-----------------------------] 0/3 (  0%) in  0s
#> 

#>   Training [=========>-------------------] 1/3 ( 33%) in  0s
#> 

#>   Training [==================>----------] 2/3 ( 67%) in  2s
#> 

#>   Training [=============================] 3/3 (100%) in  3s
#> 
#> 

#>   Training [-----------------------------] 0/3 (  0%) in  0s
#> 

#>   Training [=========>-------------------] 1/3 ( 33%) in  0s
#> 

#>   Training [==================>----------] 2/3 ( 67%) in  2s
#> 

#>   Training [=============================] 3/3 (100%) in  3s
#> 
#> 

#>   Training [-----------------------------] 0/3 (  0%) in  0s
#> 

#>   Training [=========>-------------------] 1/3 ( 33%) in  0s
#> 

#>   Training [==================>----------] 2/3 ( 67%) in  2s
#> 

#>   Training [=============================] 3/3 (100%) in  3s
#> 
markov <- mldpEHR.mortality_markov(predictors, 5, 5, qbins = seq(0, 1, by = 0.1))
#> Error in pivot_wider(., id_cols = c(sbin, sex), names_from = outcome,     values_from = est): could not find function "pivot_wider"
prob <- purrr::map2_df(markov, names(markov), ~
    as_tibble(.x$model[[1]], rownames = "sbin") %>%
        mutate(sex = 0, model = .y) %>%
        bind_rows(as_tibble(.x$model[[2]], rownames = "sbin") %>% mutate(sex = 1, model = .y))) %>%
    mutate(sbin = factor(sbin, levels = c(1:10, "death", "no_score")))
#> Error in map2(.x, .y, .f, ...): object 'markov' not found

ggplot(prob, aes(x = sbin, y = death, colour = factor(sex), group = factor(sex))) +
    geom_point() +
    geom_line() +
    facet_wrap(~model, nrow = 1) +
    theme_bw()
#> Error in ggplot(prob, aes(x = sbin, y = death, colour = factor(sex), group = factor(sex))): object 'prob' not found