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
Source:R/mortality_markov_model.R
mldpEHR.mortality_markov.Rdbuild 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