Appendix
Jens Hüsers
3/6/2020
# Load MCMC samples
files <- dir("models")
file <- files[grepl(x = files, pattern = "RDS$")]
filepath <- glue::glue("models/backup-mcmc/{file}")
informed_any <- readRDS(filepath[1])
noninformed_any <- readRDS(filepath[2])
informed_major <- readRDS(filepath[3])
noninformed_major <- readRDS(filepath[4])Non Informed Model for Any-Amputation
# assign the model
model <- noninformed_any[[4]]Effective Sample Size
The effective sample size and the effective sample size in comparison to the actual sample size.
summary(model) %>%
as.data.frame() %>%
as_tibble(rownames = "Predictors") %>%
select(Predictors, any_non = n_eff) %>%
slice(1:8) %>%
kable()| Predictors | any_non |
|---|---|
| (Intercept) | 26516 |
| p | 24728 |
| e_ordinal_5 | 25087 |
| d | 26378 |
| i | 28326 |
| s | 32397 |
| alter_bei_aufnahme | 28275 |
| gender | 31458 |
neff_ratio(model) %>% kable()| x | |
|---|---|
| (Intercept) | 0.8838667 |
| p | 0.8242667 |
| e_ordinal_5 | 0.8362333 |
| d | 0.8792667 |
| i | 0.9442000 |
| s | 1.0799000 |
| alter_bei_aufnahme | 0.9425000 |
| gender | 1.0486000 |
Autorcorrelation in the MCMC chains
Autocorrelation shown with lag plots and trace plots
mcmc_acf(as.matrix(model), lags = 10)
style <- trace_style_np(div_alpha = .1, div_size = 0.01)
mcmc_trace(as.array(model),
n_warmup = 500,
np_style = style) 
Collinearity of the Predictors
Investigtion of colliniearity with scatter- and hex plots.
mcmc_pairs(as.matrix(model), off_diag_fun = c("scatter"),
off_diag_args = list(alpha = .01, size = .5))
mcmc_pairs(as.matrix(model), off_diag_fun = c("hex"),
off_diag_args = list(alpha = .01, size = .5))
cov <- cor(as.matrix(model), method = "pearson")
colnames(cov) <- c("ic", "p", "e", "d", "i", "s", "a", "g")
diag(cov) <- NA
max(abs(cov)[-1, -1], na.rm = TRUE)## [1] 0.2749493diag(cov) <- 1
kable(cov)| ic | p | e | d | i | s | a | g | |
|---|---|---|---|---|---|---|---|---|
| (Intercept) | 1.0000000 | 0.0793537 | -0.5659471 | -0.3165202 | -0.0897339 | -0.4183069 | -0.5438922 | -0.1463428 |
| p | 0.0793537 | 1.0000000 | -0.1428090 | -0.2058443 | 0.1071609 | -0.0520479 | -0.2286700 | 0.0356635 |
| e_ordinal_5 | -0.5659471 | -0.1428090 | 1.0000000 | -0.1535834 | -0.0817196 | 0.0468094 | 0.0529626 | -0.0554157 |
| d | -0.3165202 | -0.2058443 | -0.1535834 | 1.0000000 | -0.2749493 | -0.0446428 | 0.1095093 | -0.0090532 |
| i | -0.0897339 | 0.1071609 | -0.0817196 | -0.2749493 | 1.0000000 | -0.0129428 | 0.1216458 | -0.0023816 |
| s | -0.4183069 | -0.0520479 | 0.0468094 | -0.0446428 | -0.0129428 | 1.0000000 | -0.0293552 | -0.0155554 |
| alter_bei_aufnahme | -0.5438922 | -0.2286700 | 0.0529626 | 0.1095093 | 0.1216458 | -0.0293552 | 1.0000000 | 0.0610542 |
| gender | -0.1463428 | 0.0356635 | -0.0554157 | -0.0090532 | -0.0023816 | -0.0155554 | 0.0610542 | 1.0000000 |
Posterior Predictive Checks
color_scheme_set("red")
ppc_dens_overlay(y = model$y,
yrep = posterior_predict(model, draws = 50))
Informed Model for Any-Amputation
# assign the model
model <- informed_any[[4]]Effective Sample Size
The effective sample size and the effective sample size in comparison to the actual sample size.
summary(model) %>%
as.data.frame() %>%
as_tibble(rownames = "Predictors") %>%
select(Predictors, any_non = n_eff) %>%
slice(1:8) %>%
kable()| Predictors | any_non |
|---|---|
| (Intercept) | 25945 |
| p | 29933 |
| e_ordinal_5 | 23116 |
| d | 27226 |
| i | 26024 |
| s | 33476 |
| alter_bei_aufnahme | 28278 |
| gender | 30840 |
neff_ratio(model) %>% kable()| x | |
|---|---|
| (Intercept) | 0.8648333 |
| p | 0.9977667 |
| e_ordinal_5 | 0.7705333 |
| d | 0.9075333 |
| i | 0.8674667 |
| s | 1.1158667 |
| alter_bei_aufnahme | 0.9426000 |
| gender | 1.0280000 |
Autorcorrelation in the MCMC chains
Autocorrelation shown with lag plots and trace plots
mcmc_acf(as.matrix(model), lags = 10)
style <- trace_style_np(div_alpha = .1, div_size = 0.01)
mcmc_trace(as.array(model),
n_warmup = 500,
np_style = style) 
Collinearity of the Predictors
Investigtion of colliniearity with scatter- and hex plots.
mcmc_pairs(as.matrix(model), off_diag_fun = c("scatter"),
off_diag_args = list(alpha = .01, size = .5))
mcmc_pairs(as.matrix(model), off_diag_fun = c("hex"),
off_diag_args = list(alpha = .01, size = .5))
cov <- cor(as.matrix(model), method = "pearson")
colnames(cov) <- c("ic", "p", "e", "d", "i", "s", "a", "g")
diag(cov) <- NA
max(abs(cov)[-1, -1], na.rm = TRUE)## [1] 0.2340102diag(cov) <- 1
kable(cov)| ic | p | e | d | i | s | a | g | |
|---|---|---|---|---|---|---|---|---|
| (Intercept) | 1.0000000 | 0.0349171 | -0.5861574 | -0.2856248 | -0.1529161 | -0.3706560 | -0.5751867 | -0.1663527 |
| p | 0.0349171 | 1.0000000 | -0.1427170 | -0.1357756 | 0.0897612 | -0.0226227 | -0.1966719 | 0.0211727 |
| e_ordinal_5 | -0.5861574 | -0.1427170 | 1.0000000 | -0.1311298 | -0.1029940 | 0.0298256 | 0.0549479 | -0.0463510 |
| d | -0.2856248 | -0.1357756 | -0.1311298 | 1.0000000 | -0.2340102 | -0.0123200 | 0.0749730 | -0.0023262 |
| i | -0.1529161 | 0.0897612 | -0.1029940 | -0.2340102 | 1.0000000 | -0.0243252 | 0.1645768 | -0.0026041 |
| s | -0.3706560 | -0.0226227 | 0.0298256 | -0.0123200 | -0.0243252 | 1.0000000 | -0.0164834 | -0.0133739 |
| alter_bei_aufnahme | -0.5751867 | -0.1966719 | 0.0549479 | 0.0749730 | 0.1645768 | -0.0164834 | 1.0000000 | 0.0713783 |
| gender | -0.1663527 | 0.0211727 | -0.0463510 | -0.0023262 | -0.0026041 | -0.0133739 | 0.0713783 | 1.0000000 |
Posterior Predictive Checks
color_scheme_set("red")
ppc_dens_overlay(y = model$y,
yrep = posterior_predict(model, draws = 50))
Non Informed Model for Major-Amputation
# assign the model
model <- noninformed_major[[4]]Effective Sample Size
The effective sample size and the effective sample size in comparison to the actual sample size.
summary(model) %>%
as.data.frame() %>%
as_tibble(rownames = "Predictors") %>%
select(Predictors, any_non = n_eff) %>%
slice(1:8) %>%
kable()| Predictors | any_non |
|---|---|
| (Intercept) | 21569 |
| p | 26686 |
| e_ordinal_5 | 22283 |
| d | 23718 |
| i | 28822 |
| s | 30906 |
| alter_bei_aufnahme | 29617 |
| gender | 30830 |
neff_ratio(model) %>% kable()| x | |
|---|---|
| (Intercept) | 0.7189667 |
| p | 0.8895333 |
| e_ordinal_5 | 0.7427667 |
| d | 0.7906000 |
| i | 0.9607333 |
| s | 1.0302000 |
| alter_bei_aufnahme | 0.9872333 |
| gender | 1.0276667 |
Autorcorrelation in the MCMC chains
Autocorrelation shown with lag plots and trace plots
mcmc_acf(as.matrix(model), lags = 10)
style <- trace_style_np(div_alpha = .1, div_size = 0.01)
mcmc_trace(as.array(model),
n_warmup = 500,
np_style = style) 
Collinearity of the Predictors
Investigtion of colliniearity with scatter- and hex plots.
mcmc_pairs(as.matrix(model), off_diag_fun = c("scatter"),
off_diag_args = list(alpha = .01, size = .5))
mcmc_pairs(as.matrix(model), off_diag_fun = c("hex"),
off_diag_args = list(alpha = .01, size = .5))
cov <- cor(as.matrix(model), method = "pearson")
colnames(cov) <- c("ic", "p", "e", "d", "i", "s", "a", "g")
diag(cov) <- NA
max(abs(cov)[-1, -1], na.rm = TRUE)## [1] 0.187903diag(cov) <- 1
kable(cov)| ic | p | e | d | i | s | a | g | |
|---|---|---|---|---|---|---|---|---|
| (Intercept) | 1.0000000 | 0.0847580 | -0.5746235 | -0.4403784 | -0.0979059 | -0.4175271 | -0.4247953 | -0.1055477 |
| p | 0.0847580 | 1.0000000 | -0.1774932 | -0.1752217 | 0.1749470 | -0.0368303 | -0.1879030 | 0.0316887 |
| e_ordinal_5 | -0.5746235 | -0.1774932 | 1.0000000 | -0.1362739 | -0.0514759 | 0.0247712 | 0.0269633 | -0.0503418 |
| d | -0.4403784 | -0.1752217 | -0.1362739 | 1.0000000 | -0.1786476 | -0.0081841 | 0.0720570 | 0.0043751 |
| i | -0.0979059 | 0.1749470 | -0.0514759 | -0.1786476 | 1.0000000 | -0.0203087 | 0.1177035 | -0.0018219 |
| s | -0.4175271 | -0.0368303 | 0.0247712 | -0.0081841 | -0.0203087 | 1.0000000 | -0.0184347 | -0.0172154 |
| alter_bei_aufnahme | -0.4247953 | -0.1879030 | 0.0269633 | 0.0720570 | 0.1177035 | -0.0184347 | 1.0000000 | 0.0535621 |
| gender | -0.1055477 | 0.0316887 | -0.0503418 | 0.0043751 | -0.0018219 | -0.0172154 | 0.0535621 | 1.0000000 |
Posterior Predictive Checks
color_scheme_set("red")
ppc_dens_overlay(y = model$y,
yrep = posterior_predict(model, draws = 50))
Informed Model for Major-Amputation
# assign the model
model <- informed_major[[4]]Effective Sample Size
The effective sample size and the effective sample size in comparison to the actual sample size.
summary(model) %>%
as.data.frame() %>%
as_tibble(rownames = "Predictors") %>%
select(Predictors, any_non = n_eff) %>%
slice(1:8) %>%
kable()| Predictors | any_non |
|---|---|
| (Intercept) | 18853 |
| p | 28542 |
| e_ordinal_5 | 17698 |
| d | 24427 |
| i | 28594 |
| s | 31812 |
| alter_bei_aufnahme | 29640 |
| gender | 31760 |
neff_ratio(model) %>% kable()| x | |
|---|---|
| (Intercept) | 0.6284333 |
| p | 0.9514000 |
| e_ordinal_5 | 0.5899333 |
| d | 0.8142333 |
| i | 0.9531333 |
| s | 1.0604000 |
| alter_bei_aufnahme | 0.9880000 |
| gender | 1.0586667 |
Autorcorrelation in the MCMC chains
Autocorrelation shown with lag plots and trace plots
mcmc_acf(as.matrix(model), lags = 10)
style <- trace_style_np(div_alpha = .1, div_size = 0.01)
mcmc_trace(as.array(model),
n_warmup = 500,
np_style = style) 
Collinearity of the Predictors
Investigtion of colliniearity with scatter- and hex plots.
mcmc_pairs(as.matrix(model), off_diag_fun = c("scatter"),
off_diag_args = list(alpha = .01, size = .5))
mcmc_pairs(as.matrix(model), off_diag_fun = c("hex"),
off_diag_args = list(alpha = .01, size = .5))
cov <- cor(as.matrix(model), method = "pearson")
colnames(cov) <- c("ic", "p", "e", "d", "i", "s", "a", "g")
diag(cov) <- NA
max(abs(cov)[-1, -1], na.rm = TRUE)## [1] 0.1714518diag(cov) <- 1
kable(cov)| ic | p | e | d | i | s | a | g | |
|---|---|---|---|---|---|---|---|---|
| (Intercept) | 1.0000000 | 0.0069335 | -0.5924943 | -0.4310989 | -0.1652019 | -0.3600507 | -0.4749794 | -0.1496084 |
| p | 0.0069335 | 1.0000000 | -0.1218569 | -0.1001841 | 0.1223925 | -0.0138671 | -0.1714518 | 0.0023425 |
| e_ordinal_5 | -0.5924943 | -0.1218569 | 1.0000000 | -0.0808024 | -0.0407176 | 0.0316064 | 0.0135434 | -0.0321372 |
| d | -0.4310989 | -0.1001841 | -0.0808024 | 1.0000000 | -0.1252087 | -0.0165436 | 0.0541985 | 0.0128134 |
| i | -0.1652019 | 0.1223925 | -0.0407176 | -0.1252087 | 1.0000000 | -0.0112839 | 0.1248401 | -0.0060010 |
| s | -0.3600507 | -0.0138671 | 0.0316064 | -0.0165436 | -0.0112839 | 1.0000000 | -0.0176944 | -0.0137813 |
| alter_bei_aufnahme | -0.4749794 | -0.1714518 | 0.0135434 | 0.0541985 | 0.1248401 | -0.0176944 | 1.0000000 | 0.0700661 |
| gender | -0.1496084 | 0.0023425 | -0.0321372 | 0.0128134 | -0.0060010 | -0.0137813 | 0.0700661 | 1.0000000 |
Posterior Predictive Checks
color_scheme_set("red")
ppc_dens_overlay(y = model$y,
yrep = posterior_predict(model, draws = 50))