In meyera/riskscorer: An R Package for Calculating Surgical Risk Scores
#library(pander)
#library(printr)
#library(wakefield)
suppressPackageStartupMessages(suppressMessages(suppressWarnings({
library(dplyr)
library(ggplot2)
library(riskscorer)
library(wakefield)
library(threejs)
})))
knitr::opts_chunk$set(fig.width = 6,
fig.height = 5,
cache=FALSE,
echo = FALSE)
The package riskscorer is a set of functions to provide an easy programmatical interface to clinical risk models. It supports fuzzy argument matching and is webservice ready via plumber decoration.
A the moment two operative risk scores in cardiac surgery are implemented:
The following less used scores are under development:
The programmatical interface can be used in various scenarios:
- Simulation research based on a risk score model (see Figure 1)
- Comparison of risk models
- Data pre-processing and acurate risk score gathering before analysis. (saves work at data entry stage, ensures reproduceibility and thus avoids errors)
- Usage of the webservice deployment
- for rapid batch processing of a data pool
- for clinical information systems to request on demand score calculation
Example 1: Simulated patient data. Except creatinine, LV function and gender, all covariates are fixed.
The simulated patients have the following characteristics:
- Creatinine: 0.8 - 3.0 mg/dL
- Left ventricular function: 10 - 60 %
- Sex: Male or Female
- Procedure: CABG(Bypass surgery) + AVR(aortic valve replacement)
- Weight: 75 kg
- Height: 170 cm
- Symptoms of heart failure
- Age: 75
The graphs plot the probability of 30d mortality against the left ventricular function and creatinine value.
n = 5#23
grid_df <- expand.grid(crea = rep(seq(0.8, 3, length.out = n)),
lvef = rep(seq(10, 60, length.out = n)),
gender = c("Male", "Female"))
df_sim <- grid_df %>% as.data.frame %>% as.tbl
df_sim$age = 75
df_sim$proc_cabg = TRUE
df_sim$proc_valve = "AVR"
df_sim$chf_2w = TRUE
df_sim$height_cm = 170
df_sim$weight_kg = 75
sims <- df_sim %>% group_by(lvef, crea, gender) %>% do(
calc_sts(proc_valve = .$proc_valve,
proc_cabg = .$proc_cabg,
age = .$age,
gender = .$gender,
chf_2w = .$chf_2w,
crea = .$crea,
height_cm = .$height_cm,
weight_kg = .$weight_kg,
lvef = .$lvef)
#data_frame(proc_valve = .$VALVE, proc_cabg = .$CABG, age = .$Age, gender = .$Sex, crea = .$crea, lvef = .$lvef)
)
sims_long <- tidyr::gather(data = sims, key = Risk, value = probability, Mortality:Short_LOS)
prom <- sims_long %>% dplyr::filter(Risk == "Mortality")
threejs::scatterplot3js(y = prom$crea, x= prom$lvef, z = prom$probability,
color = ifelse(prom$gender == "Male", "lightblue", "red"),
grid ="TRUE",
labels=sprintf("Sex=%s, Crea=%.2f mg/dL, LVEF=%.2f %%, PROM=%.2f %%",
prom$gender,
prom$crea,
prom$lvef,
prom$probability*100),
renderer = "canvas")
#plotly::3d
# plot3D::scatter3D(y = prom$crea, x= prom$lvef, z = prom$probability)
# plot3D::scatter3D(y = prom$crea, x= prom$lvef, z = prom$probability,
# phi = 40, theta = 70)
# plot3D::scatter3D(y = prom$crea, x= prom$lvef, z = prom$probability,
# phi = 0, theta = 70)
# plot3D::scatter3D(y = prom$crea, x= prom$lvef, z = prom$probability,
# phi = -20, theta = 70)
# plot3D::scatter3D(y = prom$crea, x= prom$lvef, z = prom$probability,
# phi = -30, theta = 70)
# prom_gen <- prom %>% dplyr::filter(gender == "Female")
# plot3D::scatter3D(y = prom_gen$crea, x= prom_gen$lvef, z = prom_gen$probability,
# theta = 50, phi = 10, ticktype = "detailed", bty = "f",
# zlim = c(0, 0.1), d=2, pch=1,
# main ="STS Scores",
# xlab = "LVEF [%]",
# ylab = "Crea [mg/dL]",
# zlab = "STS PROM %",
# clab = "STS PROM %")
# prom_gen <- prom %>% dplyr::filter(gender == "Male")
# plot3D::scatter3D(y = prom_gen$crea, x= prom_gen$lvef, z = prom_gen$probability,
# theta = 50, phi = 10, pch = 16, add = TRUE, colkey = FALSE)
# library(ggplot2)
# ggplot(prom, aes(x = lvef, y = crea, z = probability, fill = probability)) +
# facet_wrap(~ gender) +
# geom_raster() +
# scale_fill_gradient("STS PROM %", low = "red", high = "yellow") +
# geom_contour(color = "black", bins = 20) +
# labs(x = "LVEF [%]", y = "Crea [mg/dL]") +
# theme_minimal()
#
#
# library(lattice)
# lattice::wireframe(probability ~ lvef + crea, data = prom,
# groups = gender,
# drape = TRUE,
# colorkey = TRUE,
# shade = FALSE,
# xlab = "LVEF [%]",
# ylab = "Crea [mg/dL]",
# zlab = "STS PROM %")
#
# scatterplot3d::scatterplot3d(y = prom$crea,
# x= prom$lvef,
# z = prom$probability,
# #highlight.3d=TRUE,
# grid = TRUE, pch=16,
# box = FALSE,#type = "l",
# color = ifelse(prom$gender == "Male", "blue", "red"))
Example 2: Simulated patient data. Except creatinine and gender, all covariates are fixed.
The simulated patients have the following characteristics:
- Creatinine: 0.8 - 3.0 mg/dL
- Sex: Male or Female
- Left ventricular function: 45 %
- Procedure: AVR(aortic valve replacement)
- Weight: 75 kg
- Height: 170 cm
- Symptoms of heart failure
- Age: 75
The graphs plot the probability of each risk category against the gender and creatinine value.
n = 3#23
grid_df <- expand.grid(crea = rep(seq(0.8, 3, length.out = n)),
gender = c("Male", "Female"))
df_sim <- grid_df %>% as.data.frame %>% as.tbl
df_sim$age = 75
df_sim$lvef = 45
df_sim$proc_cabg = TRUE
df_sim$proc_valve = "AVR"
df_sim$chf_2w = TRUE
df_sim$height_cm = 170
df_sim$weight_kg = 75
sims <- df_sim %>% group_by(crea, gender) %>% do(
calc_sts(proc_valve = .$proc_valve,
proc_cabg = .$proc_cabg,
age = .$age,
gender = .$gender,
chf_2w = .$chf_2w,
crea = .$crea,
height_cm = .$height_cm,
weight_kg = .$weight_kg,
lvef = .$lvef)
)
sims_long <- tidyr::gather(data = sims, key = Risk, value = probability, Mortality:Short_LOS)
qplot(x = crea, y = probability, facets = ~gender, color = Risk, data = sims_long, geom = c("line")) + theme_bw()
qplot(x = crea, y = probability, facets = ~Risk, color = gender, data = sims_long, geom = c("line")) + theme_bw()
Example 3: clusters of a two cohorts of typical multimorbid TAVR (transcatheter heart valve replacement) and typical younger CABG only patients
The simulated patients have the following characteristics:
- TAVI cohort
- Procedure: AVR(aortic valve replacement)
- Gender: : random distribution (probability: M = 0.5122, no = 0.4878)
- Age: random age in range 78 - 100 years
- Left ventricular function: random lvef (mean=50, sd=10)
- Creatinine: random creatinine value (mean=1.2, sd=0.2)
- Symptoms of heart failure: random distribution (probability: yes = 0.9, no = 0.1)
- CABG cohort
- Procedure: CABG
- Gender: : random distribution (probability: M = 0.5122, no = 0.4878)
- Age: random age in range 40 - 70 years
- Left ventricular function: random lvef (mean=50, sd=10)
- Creatinine: random creatinine value (mean=0.8, sd=0.1)
- Symptoms of heart failure: random distribution (probability: yes = 0.2, no = 0.8)
set.seed(5)
n = 3
df_sim_tavi <- r_data_frame(
n = n,
age(x = 78:100),
sex,
lvef = round(rnorm(n = n, mean = 50, sd = 10), digits = 0),
crea = round(rnorm(n = n, mean = 1.2, sd = 0.2), digits = 3),
valid(name = "chf_2w", prob = c(0.1,0.9))
)
df_sim_tavi$Patient = 1:(nrow(df_sim_tavi))
df_sim_tavi$CABG = FALSE
df_sim_tavi$VALVE = "AVR"
df_sim_cabg <- r_data_frame(
n = n,
age(x = 40:70),
sex,
lvef = round(rnorm(n = n, mean = 50, sd = 10), digits = 0),
crea = round(rnorm(n = n, mean = 0.8, sd = 0.1), digits = 3),
valid(name = "chf_2w", prob = c(0.8,0.2))
)
df_sim_cabg$Patient = (nrow(df_sim_tavi)+1):(nrow(df_sim_tavi) + nrow(df_sim_cabg))
df_sim_cabg$CABG = TRUE
df_sim_cabg$VALVE = FALSE
sims <- rbind(df_sim_cabg, df_sim_tavi) %>% group_by(Patient) %>% do(
calc_sts(proc_valve = .$VALVE,
proc_cabg = .$CABG,
age = .$Age,
gender = .$Sex,
chf_2w = .$chf_2w,
crea = .$crea,
lvef = .$lvef)
#data_frame(proc_valve = .$VALVE, proc_cabg = .$CABG, age = .$Age, gender = .$Sex, crea = .$crea, lvef = .$lvef)
)
tab_view <- sims %>%
dplyr::rename(STS_Risk_Model = Procedure) %>%
dplyr::arrange(Patient, Mortality)
knitr::kable(tab_view %>% dplyr::select(Patient,
Risk_Model = STS_Risk_Model,
Mort = Mortality,
Mort_Morb = Morbidity_Mortality ,
Stroke = Perm_Stroke,
Long_Vent = Prolong_Vent,
ReOP=Reoperation,
Renal_failure,
DSW_Infect=DSW_Infection,
Long_LOS))
# library(dendextend)
# km <- kmeans(dplyr::select(tab_view, -Patient, -STS_Risk_Model) %>% dist, centers = 2)
# km
# dend <- dplyr::select(tab_view, -Patient, -STS_Risk_Model) %>% dist(method = "maximum") %>% hclust(method = "average") %>% as.dendrogram
# dend %>% set("branches_k_color") %>% plot
# dend %>% set("branches_k_color") %>% rect.dendrogram(k=2, border = 8, lty = 5, lwd = 2) %>% plot
p <- radial_plot(sims %>% dplyr::select(-Short_LOS, -Procedure) %>% dplyr::rename(group = Patient) %>% as.data.frame,
grid.min = 0, grid.max = 0.3,legend.title = "Patient",
plot.extent.x = 1.7, plot.extent.y = 1.2,
label.centre.y = FALSE, centre.y = -0.1,
group.line.width = 0.1,
group.point.size = 2
)
p
STS Score Implemtation
The STS(The Society of Thoracic Surgeons) score is a collection of validated risk models that are regulary updated based on the broad data base of the STS.The online STS adult cardiac surgery risk calculator is an Angular single page application, which collects the parameters and commincates via JSON to a a web-service("http://riskcalc.sts.org/stswebriskcalc/v1/calculate/stsall ") to obtain the scores.
The STS score calculation in the riskscorer package is realized by providing a user friendly programmatical interface to the web-service.
The programming interface is able to handle most of data codings automatically. Simple heuristics translate common clinical factor codings. For example "Female", "female" or "f" will all be detected as female gender. Boolean variables such as '0', '1', 'True', 'T', "Y", "Yes" will be detected. Each parameter is described in detail at the corresponding function documentation. Once the score is calculated, a data frame is returned, making it easy to work with the pipe and dplyr.
Terms of use of STS web calculator does not permit the use of the web-service at the moment of writing this vignette. Keep in mind, that this might change and consider to check the terms of use at the STS score website before using the function.
Web Service
Thanks to the fantastic plumber package, every score calculation function can be easily used as a web service. The hosting of such a service is well documented at the plumber documentation.
ES II implementation
The risk calculation of the EuroScore II is based on a logistic regression model and the coefficients are published in doi:10.1093/ejcts/ezs043. Therefor one can easily use the published coefficients and impose a robust R interface over the model.
ES II examples
n = 5
grid_df <- expand.grid(crea = rep(seq(0.8, 3, length.out = n)),
lvef = rep(seq(10, 60, length.out = n)),
gender = c("Male", "Female"))
df_sim <- grid_df %>% as.data.frame %>% as.tbl
v_cc_eGFR <- Vectorize(cc_eGFR)
df_sim$age = 75
df_sim$proc_cabg = TRUE
df_sim$proc_valve = TRUE
df_sim$urgency = "elective"
df_sim$height_cm = 170
df_sim$weight_kg = 75
df_sim$sPAP = 33
df_sim$renal = v_cc_eGFR(crea = df_sim$crea,
weight = df_sim$weight_kg,
age = df_sim$age,
sex = df_sim$gender)
sims <- df_sim %>% group_by(lvef, crea, gender) %>% do(
data_frame(Mortality = calc_esII(valve_surgery = .$proc_valve,
CABG = .$proc_cabg,
age = .$age,
gender = .$gender,
renal = .$renal,
sPAP = .$lvef,
urgency = .$urgency,
lv = .$lvef))
#data_frame(proc_valve = .$VALVE, proc_cabg = .$CABG, age = .$Age, gender = .$Sex, crea = .$crea, lvef = .$lvef)
)
#sims_long <- tidyr::gather(data = sims, key = Risk, value = probability, Mortality:Short_LOS)
threejs::scatterplot3js(y = sims$crea, x= sims$lvef, z = sims$Mortality,
color = ifelse(sims$gender == "Male", "lightblue", "red"),
grid ="TRUE",
labels=sprintf("Sex=%s, Crea=%.2f mg/dL, LVEF=%.2f %%, PROM=%.2f %%",
sims$gender,
sims$crea,
sims$lvef,
sims$Mortality*100),
renderer = "canvas")
#qplot(x = lvef, y = Mortality, facets = ~gender, color = crea, data = sims, geom = c("point")) + theme_bw()
middle <- function(x) {
r <- range(x)
(abs(r[2] - r[1])/2) + r[1]
}
ggplot(data = sims, aes(x=lvef, y=crea, fill=Mortality)) +
geom_tile() + theme_minimal() + #geom_point(aes(size = Mortality)) +
facet_wrap(facets = ~ gender) +
scale_fill_gradient2(low = "blue", high = "red", mid = "white", midpoint = middle(sims$Mortality),
space = "Lab", name="EuroScore II\nMortality")
meyera/riskscorer documentation built on May 22, 2019, 7:54 p.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
#library(pander) #library(printr) #library(wakefield) suppressPackageStartupMessages(suppressMessages(suppressWarnings({ library(dplyr) library(ggplot2) library(riskscorer) library(wakefield) library(threejs) }))) knitr::opts_chunk$set(fig.width = 6, fig.height = 5, cache=FALSE, echo = FALSE)
The package riskscorer is a set of functions to provide an easy programmatical interface to clinical risk models. It supports fuzzy argument matching and is webservice ready via plumber decoration. A the moment two operative risk scores in cardiac surgery are implemented:
The following less used scores are under development:
The programmatical interface can be used in various scenarios:
- Simulation research based on a risk score model (see Figure 1)
- Comparison of risk models
- Data pre-processing and acurate risk score gathering before analysis. (saves work at data entry stage, ensures reproduceibility and thus avoids errors)
- Usage of the webservice deployment
- for rapid batch processing of a data pool
- for clinical information systems to request on demand score calculation
Example 1: Simulated patient data. Except creatinine, LV function and gender, all covariates are fixed.
The simulated patients have the following characteristics:
- Creatinine: 0.8 - 3.0 mg/dL
- Left ventricular function: 10 - 60 %
- Sex: Male or Female
- Procedure: CABG(Bypass surgery) + AVR(aortic valve replacement)
- Weight: 75 kg
- Height: 170 cm
- Symptoms of heart failure
- Age: 75
The graphs plot the probability of 30d mortality against the left ventricular function and creatinine value.
n = 5#23 grid_df <- expand.grid(crea = rep(seq(0.8, 3, length.out = n)), lvef = rep(seq(10, 60, length.out = n)), gender = c("Male", "Female")) df_sim <- grid_df %>% as.data.frame %>% as.tbl df_sim$age = 75 df_sim$proc_cabg = TRUE df_sim$proc_valve = "AVR" df_sim$chf_2w = TRUE df_sim$height_cm = 170 df_sim$weight_kg = 75 sims <- df_sim %>% group_by(lvef, crea, gender) %>% do( calc_sts(proc_valve = .$proc_valve, proc_cabg = .$proc_cabg, age = .$age, gender = .$gender, chf_2w = .$chf_2w, crea = .$crea, height_cm = .$height_cm, weight_kg = .$weight_kg, lvef = .$lvef) #data_frame(proc_valve = .$VALVE, proc_cabg = .$CABG, age = .$Age, gender = .$Sex, crea = .$crea, lvef = .$lvef) ) sims_long <- tidyr::gather(data = sims, key = Risk, value = probability, Mortality:Short_LOS) prom <- sims_long %>% dplyr::filter(Risk == "Mortality") threejs::scatterplot3js(y = prom$crea, x= prom$lvef, z = prom$probability, color = ifelse(prom$gender == "Male", "lightblue", "red"), grid ="TRUE", labels=sprintf("Sex=%s, Crea=%.2f mg/dL, LVEF=%.2f %%, PROM=%.2f %%", prom$gender, prom$crea, prom$lvef, prom$probability*100), renderer = "canvas") #plotly::3d # plot3D::scatter3D(y = prom$crea, x= prom$lvef, z = prom$probability) # plot3D::scatter3D(y = prom$crea, x= prom$lvef, z = prom$probability, # phi = 40, theta = 70) # plot3D::scatter3D(y = prom$crea, x= prom$lvef, z = prom$probability, # phi = 0, theta = 70) # plot3D::scatter3D(y = prom$crea, x= prom$lvef, z = prom$probability, # phi = -20, theta = 70) # plot3D::scatter3D(y = prom$crea, x= prom$lvef, z = prom$probability, # phi = -30, theta = 70) # prom_gen <- prom %>% dplyr::filter(gender == "Female") # plot3D::scatter3D(y = prom_gen$crea, x= prom_gen$lvef, z = prom_gen$probability, # theta = 50, phi = 10, ticktype = "detailed", bty = "f", # zlim = c(0, 0.1), d=2, pch=1, # main ="STS Scores", # xlab = "LVEF [%]", # ylab = "Crea [mg/dL]", # zlab = "STS PROM %", # clab = "STS PROM %") # prom_gen <- prom %>% dplyr::filter(gender == "Male") # plot3D::scatter3D(y = prom_gen$crea, x= prom_gen$lvef, z = prom_gen$probability, # theta = 50, phi = 10, pch = 16, add = TRUE, colkey = FALSE) # library(ggplot2) # ggplot(prom, aes(x = lvef, y = crea, z = probability, fill = probability)) + # facet_wrap(~ gender) + # geom_raster() + # scale_fill_gradient("STS PROM %", low = "red", high = "yellow") + # geom_contour(color = "black", bins = 20) + # labs(x = "LVEF [%]", y = "Crea [mg/dL]") + # theme_minimal() # # # library(lattice) # lattice::wireframe(probability ~ lvef + crea, data = prom, # groups = gender, # drape = TRUE, # colorkey = TRUE, # shade = FALSE, # xlab = "LVEF [%]", # ylab = "Crea [mg/dL]", # zlab = "STS PROM %") # # scatterplot3d::scatterplot3d(y = prom$crea, # x= prom$lvef, # z = prom$probability, # #highlight.3d=TRUE, # grid = TRUE, pch=16, # box = FALSE,#type = "l", # color = ifelse(prom$gender == "Male", "blue", "red"))
Example 2: Simulated patient data. Except creatinine and gender, all covariates are fixed.
The simulated patients have the following characteristics:
- Creatinine: 0.8 - 3.0 mg/dL
- Sex: Male or Female
- Left ventricular function: 45 %
- Procedure: AVR(aortic valve replacement)
- Weight: 75 kg
- Height: 170 cm
- Symptoms of heart failure
- Age: 75
The graphs plot the probability of each risk category against the gender and creatinine value.
n = 3#23 grid_df <- expand.grid(crea = rep(seq(0.8, 3, length.out = n)), gender = c("Male", "Female")) df_sim <- grid_df %>% as.data.frame %>% as.tbl df_sim$age = 75 df_sim$lvef = 45 df_sim$proc_cabg = TRUE df_sim$proc_valve = "AVR" df_sim$chf_2w = TRUE df_sim$height_cm = 170 df_sim$weight_kg = 75 sims <- df_sim %>% group_by(crea, gender) %>% do( calc_sts(proc_valve = .$proc_valve, proc_cabg = .$proc_cabg, age = .$age, gender = .$gender, chf_2w = .$chf_2w, crea = .$crea, height_cm = .$height_cm, weight_kg = .$weight_kg, lvef = .$lvef) ) sims_long <- tidyr::gather(data = sims, key = Risk, value = probability, Mortality:Short_LOS) qplot(x = crea, y = probability, facets = ~gender, color = Risk, data = sims_long, geom = c("line")) + theme_bw() qplot(x = crea, y = probability, facets = ~Risk, color = gender, data = sims_long, geom = c("line")) + theme_bw()
Example 3: clusters of a two cohorts of typical multimorbid TAVR (transcatheter heart valve replacement) and typical younger CABG only patients
The simulated patients have the following characteristics:
- TAVI cohort
- Procedure: AVR(aortic valve replacement)
- Gender: : random distribution (probability: M = 0.5122, no = 0.4878)
- Age: random age in range 78 - 100 years
- Left ventricular function: random lvef (mean=50, sd=10)
- Creatinine: random creatinine value (mean=1.2, sd=0.2)
- Symptoms of heart failure: random distribution (probability: yes = 0.9, no = 0.1)
- CABG cohort
- Procedure: CABG
- Gender: : random distribution (probability: M = 0.5122, no = 0.4878)
- Age: random age in range 40 - 70 years
- Left ventricular function: random lvef (mean=50, sd=10)
- Creatinine: random creatinine value (mean=0.8, sd=0.1)
- Symptoms of heart failure: random distribution (probability: yes = 0.2, no = 0.8)
set.seed(5) n = 3 df_sim_tavi <- r_data_frame( n = n, age(x = 78:100), sex, lvef = round(rnorm(n = n, mean = 50, sd = 10), digits = 0), crea = round(rnorm(n = n, mean = 1.2, sd = 0.2), digits = 3), valid(name = "chf_2w", prob = c(0.1,0.9)) ) df_sim_tavi$Patient = 1:(nrow(df_sim_tavi)) df_sim_tavi$CABG = FALSE df_sim_tavi$VALVE = "AVR" df_sim_cabg <- r_data_frame( n = n, age(x = 40:70), sex, lvef = round(rnorm(n = n, mean = 50, sd = 10), digits = 0), crea = round(rnorm(n = n, mean = 0.8, sd = 0.1), digits = 3), valid(name = "chf_2w", prob = c(0.8,0.2)) ) df_sim_cabg$Patient = (nrow(df_sim_tavi)+1):(nrow(df_sim_tavi) + nrow(df_sim_cabg)) df_sim_cabg$CABG = TRUE df_sim_cabg$VALVE = FALSE sims <- rbind(df_sim_cabg, df_sim_tavi) %>% group_by(Patient) %>% do( calc_sts(proc_valve = .$VALVE, proc_cabg = .$CABG, age = .$Age, gender = .$Sex, chf_2w = .$chf_2w, crea = .$crea, lvef = .$lvef) #data_frame(proc_valve = .$VALVE, proc_cabg = .$CABG, age = .$Age, gender = .$Sex, crea = .$crea, lvef = .$lvef) ) tab_view <- sims %>% dplyr::rename(STS_Risk_Model = Procedure) %>% dplyr::arrange(Patient, Mortality) knitr::kable(tab_view %>% dplyr::select(Patient, Risk_Model = STS_Risk_Model, Mort = Mortality, Mort_Morb = Morbidity_Mortality , Stroke = Perm_Stroke, Long_Vent = Prolong_Vent, ReOP=Reoperation, Renal_failure, DSW_Infect=DSW_Infection, Long_LOS)) # library(dendextend) # km <- kmeans(dplyr::select(tab_view, -Patient, -STS_Risk_Model) %>% dist, centers = 2) # km # dend <- dplyr::select(tab_view, -Patient, -STS_Risk_Model) %>% dist(method = "maximum") %>% hclust(method = "average") %>% as.dendrogram # dend %>% set("branches_k_color") %>% plot # dend %>% set("branches_k_color") %>% rect.dendrogram(k=2, border = 8, lty = 5, lwd = 2) %>% plot p <- radial_plot(sims %>% dplyr::select(-Short_LOS, -Procedure) %>% dplyr::rename(group = Patient) %>% as.data.frame, grid.min = 0, grid.max = 0.3,legend.title = "Patient", plot.extent.x = 1.7, plot.extent.y = 1.2, label.centre.y = FALSE, centre.y = -0.1, group.line.width = 0.1, group.point.size = 2 ) p
STS Score Implemtation
The STS(The Society of Thoracic Surgeons) score is a collection of validated risk models that are regulary updated based on the broad data base of the STS.The online STS adult cardiac surgery risk calculator is an Angular single page application, which collects the parameters and commincates via JSON to a a web-service("http://riskcalc.sts.org/stswebriskcalc/v1/calculate/stsall ") to obtain the scores.
The STS score calculation in the riskscorer package is realized by providing a user friendly programmatical interface to the web-service. The programming interface is able to handle most of data codings automatically. Simple heuristics translate common clinical factor codings. For example "Female", "female" or "f" will all be detected as female gender. Boolean variables such as '0', '1', 'True', 'T', "Y", "Yes" will be detected. Each parameter is described in detail at the corresponding function documentation. Once the score is calculated, a data frame is returned, making it easy to work with the pipe and dplyr.
Terms of use of STS web calculator does not permit the use of the web-service at the moment of writing this vignette. Keep in mind, that this might change and consider to check the terms of use at the STS score website before using the function.
Web Service
Thanks to the fantastic plumber package, every score calculation function can be easily used as a web service. The hosting of such a service is well documented at the plumber documentation.
ES II implementation
The risk calculation of the EuroScore II is based on a logistic regression model and the coefficients are published in doi:10.1093/ejcts/ezs043. Therefor one can easily use the published coefficients and impose a robust R interface over the model.
ES II examples
n = 5 grid_df <- expand.grid(crea = rep(seq(0.8, 3, length.out = n)), lvef = rep(seq(10, 60, length.out = n)), gender = c("Male", "Female")) df_sim <- grid_df %>% as.data.frame %>% as.tbl v_cc_eGFR <- Vectorize(cc_eGFR) df_sim$age = 75 df_sim$proc_cabg = TRUE df_sim$proc_valve = TRUE df_sim$urgency = "elective" df_sim$height_cm = 170 df_sim$weight_kg = 75 df_sim$sPAP = 33 df_sim$renal = v_cc_eGFR(crea = df_sim$crea, weight = df_sim$weight_kg, age = df_sim$age, sex = df_sim$gender) sims <- df_sim %>% group_by(lvef, crea, gender) %>% do( data_frame(Mortality = calc_esII(valve_surgery = .$proc_valve, CABG = .$proc_cabg, age = .$age, gender = .$gender, renal = .$renal, sPAP = .$lvef, urgency = .$urgency, lv = .$lvef)) #data_frame(proc_valve = .$VALVE, proc_cabg = .$CABG, age = .$Age, gender = .$Sex, crea = .$crea, lvef = .$lvef) ) #sims_long <- tidyr::gather(data = sims, key = Risk, value = probability, Mortality:Short_LOS) threejs::scatterplot3js(y = sims$crea, x= sims$lvef, z = sims$Mortality, color = ifelse(sims$gender == "Male", "lightblue", "red"), grid ="TRUE", labels=sprintf("Sex=%s, Crea=%.2f mg/dL, LVEF=%.2f %%, PROM=%.2f %%", sims$gender, sims$crea, sims$lvef, sims$Mortality*100), renderer = "canvas") #qplot(x = lvef, y = Mortality, facets = ~gender, color = crea, data = sims, geom = c("point")) + theme_bw() middle <- function(x) { r <- range(x) (abs(r[2] - r[1])/2) + r[1] } ggplot(data = sims, aes(x=lvef, y=crea, fill=Mortality)) + geom_tile() + theme_minimal() + #geom_point(aes(size = Mortality)) + facet_wrap(facets = ~ gender) + scale_fill_gradient2(low = "blue", high = "red", mid = "white", midpoint = middle(sims$Mortality), space = "Lab", name="EuroScore II\nMortality")
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.