335 lines
11 KiB
R
335 lines
11 KiB
R
## Examples
|
|
|
|
# stRoke::talos |>
|
|
# dplyr::mutate(across(tidyselect::starts_with("mrs"), as.numeric)) |>
|
|
# stRoke::generic_stroke(group = "rtreat", score = "mrs_6", variables = c("hypertension", "diabetes", "civil")) |>
|
|
# purrr::pluck(3)
|
|
#
|
|
# stRoke::talos |>
|
|
# dplyr::mutate(mrs_6_bin = as.numeric(mrs_6 < 1)) |>
|
|
# finalfit::or_plot(dependent = "mrs_6_bin", explanatory = c("hypertension", "diabetes", "civil"))
|
|
|
|
|
|
# Consider utilising plotting like finalfit::or_plot
|
|
|
|
|
|
## Sample data
|
|
# df_coefs <- list(
|
|
# mrs_6 = stRoke::talos |>
|
|
# dplyr::select(tidyselect::all_of(c("mrs_6", "rtreat", "hypertension", "diabetes", "civil"))) |>
|
|
# lm(data = _, mrs_6 ~ .),
|
|
# mrs_1 = stRoke::talos |>
|
|
# dplyr::select(tidyselect::all_of(c("mrs_1", "rtreat", "hypertension", "diabetes", "civil"))) |>
|
|
# lm(data = _, mrs_1 ~ .)
|
|
# ) |>
|
|
# lapply(gtsummary::tbl_regression) |>
|
|
# purrr::map(function(.x) {
|
|
# .x |> purrr::pluck("table_body") |>
|
|
# dplyr::select(tidyselect::all_of(c("variable","estimate"))) |>
|
|
# na.omit()
|
|
# }) |> purrr::reduce(dplyr::full_join,by="variable") |>
|
|
# setNames(c("variable","increase","decrease"))
|
|
|
|
get_coefs(path = here::here("1 PA Decline/Fra DDV/240624/pa_change_analyses.docx"),index.table = 2)
|
|
|
|
|
|
source(here::here("1 PA Decline/dst import.R"))
|
|
df_coefs_raw <- get_coefs(path = here::here("1 PA Decline/Fra DDV/240624/pa_change_analyses.docx"),index.table = 2) |>
|
|
dplyr::filter(variable != "(Intercept)") |>
|
|
dplyr::select(variable, hop_median, drop_median) |>
|
|
setNames(c("variable", "INCREASE", "DECREASE"))
|
|
|
|
## Real work
|
|
df_coefs <- df_coefs_raw |>
|
|
dplyr::mutate(dplyr::across(
|
|
tidyselect::all_of(c("INCREASE", "DECREASE")),
|
|
function(.x) {
|
|
# signif(
|
|
as.numeric(.x)#,
|
|
# 3
|
|
# )
|
|
}
|
|
)) |>
|
|
dplyr::mutate(variable = dplyr::if_else(variable == "Alcohol consumption above recommendations",
|
|
"High alcohol consumption", variable
|
|
))|>
|
|
## Important step to keep the data ordered for ggplot
|
|
(function(.y) {
|
|
.y |> dplyr::mutate(variable = factor(variable, levels = rev(.y$variable)))
|
|
})()
|
|
|
|
## Highest ORs
|
|
list(df_coefs[c(1,2)],df_coefs[c(1,3)]) |>
|
|
setNames(names(df_coefs)[2:3]) |>
|
|
purrr::map(function(.x){
|
|
.x |>
|
|
setNames(c("var","val"))|>
|
|
dplyr::mutate(sorting=abs(log(val))) |>
|
|
dplyr::arrange(1-sorting) |>
|
|
dplyr::mutate(dplyr::across(dplyr::where(is.numeric),~signif(.x,2))) |>
|
|
head(5)
|
|
})
|
|
|
|
|
|
df_long <- df_coefs |>
|
|
tidyr::pivot_longer(cols = !tidyselect::matches("variable")) |>
|
|
dplyr::mutate(name = factor(name, levels = rev(unique(name))))
|
|
|
|
|
|
cols <- c(
|
|
"#CE0045",
|
|
"#66c1a3"
|
|
) # Lighter Midtrød
|
|
|
|
|
|
create_log_tics <- function(data){
|
|
sort(round(unique(c(1/data,data)),2))
|
|
}
|
|
|
|
x.tics <- create_log_tics(c(.25, .4, .6, .8, 1))
|
|
|
|
legend.title=""
|
|
|
|
levels(df_long$name) <- c("OR for decrease",
|
|
"OR for increase")
|
|
|
|
p1 <- df_long |>
|
|
# dplyr::filter(name=="decrease") |>
|
|
ggplot2::ggplot(ggplot2::aes(x = log(value), y = variable, color = name, fill = name)) +
|
|
ggplot2::geom_vline(ggplot2::aes(xintercept = 0), linewidth = .5, linetype = "dashed") +
|
|
# ggplot2::geom_errorbarh(ggplot2::aes(xmax = boxCIHigh, xmin = boxCILow), size = .5, height =
|
|
# .2, color = "gray50") +
|
|
ggplot2::geom_point(ggplot2::aes(shape = name), size = 6) +
|
|
# ggplot2::coord_trans(x = scales:::exp_trans(10)) +
|
|
ggplot2::scale_x_continuous(
|
|
breaks = log(x.tics),
|
|
labels = x.tics,
|
|
limits = log(range(x.tics))
|
|
) +
|
|
ggplot2::scale_color_manual(values = cols) +
|
|
ggplot2::scale_fill_manual(values = cols) +
|
|
ggplot2::scale_shape_manual(values=c(25,24)) +
|
|
ggplot2::theme_bw() +
|
|
ggplot2::theme(panel.grid.minor = ggplot2::element_blank(),
|
|
# legend.title = ggplot2::element_text(""),
|
|
legend.position = "bottom") +
|
|
ggplot2::ylab("") +
|
|
ggplot2::xlab("Odds ratio (log)") +
|
|
ggplot2::labs(shape=legend.title,
|
|
color=legend.title,
|
|
fill=legend.title)
|
|
|
|
#
|
|
# png(
|
|
# filename = here::here("1 PA Decline/coef_plot_change_ARTICLEA.png"),
|
|
# units = "mm",
|
|
# width = 300,
|
|
# height = 300,
|
|
# pointsize = 5,
|
|
# res = 300
|
|
# )
|
|
# p1 +
|
|
# # ggplot2::theme_minimal() +
|
|
# ggplot2::theme(
|
|
# # legend.position = "none",
|
|
# # panel.grid.major = ggplot2::element_blank(),
|
|
# # panel.grid.minor = ggplot2::element_blank(),
|
|
# # axis.text.y = ggplot2::element_blank(),
|
|
# # axis.title.y = ggplot2::element_blank(),
|
|
# # axis.text.x = element_blank(),
|
|
# text = ggplot2::element_text(size = 25)#,
|
|
# # plot.title = element_text(),
|
|
# # panel.background = ggplot2::element_rect(fill = "transparent")#,
|
|
# # plot.background = ggplot2::element_rect(fill = "transparent", color = NA)
|
|
# )
|
|
# dev.off()
|
|
|
|
|
|
x.tics <- create_log_tics(c(.25, .6, 1))
|
|
|
|
ggplot2::ggsave(
|
|
filename = here::here("1 PA Decline/coef_plot_change_ARTICLEA_facet.png"),
|
|
plot = p1 +
|
|
ggplot2::scale_x_continuous(
|
|
breaks = log(x.tics),
|
|
labels = x.tics,
|
|
limits = log(range(x.tics))
|
|
) +
|
|
ggplot2::facet_wrap(facets = ggplot2::vars(name),ncol=2) +
|
|
# ggplot2::theme_minimal() +
|
|
ggplot2::theme(
|
|
legend.position = "none",
|
|
# panel.grid.major = ggplot2::element_blank(),
|
|
# panel.grid.minor = ggplot2::element_blank(),
|
|
# axis.text.y = ggplot2::element_blank(),
|
|
# axis.title.y = ggplot2::element_blank(),
|
|
# axis.text.x = element_blank(),
|
|
text = ggplot2::element_text(size = 16)#,
|
|
# plot.title = element_text(),
|
|
# panel.background = ggplot2::element_rect(fill = "transparent")#,
|
|
# plot.background = ggplot2::element_rect(fill = "transparent", color = NA)
|
|
),
|
|
units = "mm",
|
|
width = 200,
|
|
height = 200,
|
|
pointsize = 5,
|
|
dpi = 600
|
|
)
|
|
|
|
ggplot2::ggsave(
|
|
filename = here::here("1 PA Decline/coef_plot_change_ARTICLEA_facet.pdf"),
|
|
plot = p1 +
|
|
ggplot2::scale_x_continuous(
|
|
breaks = log(x.tics),
|
|
labels = x.tics,
|
|
limits = log(range(x.tics))
|
|
) +
|
|
ggplot2::facet_wrap(facets = ggplot2::vars(name),ncol=2) +
|
|
# ggplot2::theme_minimal() +
|
|
ggplot2::theme(
|
|
legend.position = "none",
|
|
# panel.grid.major = ggplot2::element_blank(),
|
|
# panel.grid.minor = ggplot2::element_blank(),
|
|
# axis.text.y = ggplot2::element_blank(),
|
|
# axis.title.y = ggplot2::element_blank(),
|
|
# axis.text.x = element_blank(),
|
|
text = ggplot2::element_text(size = 16)#,
|
|
# plot.title = element_text(),
|
|
# panel.background = ggplot2::element_rect(fill = "transparent")#,
|
|
# plot.background = ggplot2::element_rect(fill = "transparent", color = NA)
|
|
),
|
|
units = "mm",
|
|
width = 200,
|
|
height = 200,
|
|
pointsize = 5,
|
|
dpi = 1200
|
|
)
|
|
|
|
|
|
|
|
# p1 <- df_long |>
|
|
# # dplyr::mutate(value=log10(value)
|
|
# # ) |>
|
|
# ggplot2::ggplot(ggplot2::aes(x = variable, y = log(value), fill = name)) +
|
|
# ggplot2::geom_bar(stat = "identity", position = ggplot2::position_dodge()) +
|
|
# ggplot2::coord_trans(y = scales:::exp_trans(10)) +
|
|
# ggplot2::scale_y_continuous(
|
|
# breaks = log10(c(.2, .4, .5, 1, 1.2, 1.4, 1.6, 2, 2.5)),
|
|
# labels = c(.2, .4, .5, 1, 1.2, 1.4, 1.6, 2, 2.5),
|
|
# limits = log10(c(0.09, 2.5))
|
|
# ) +
|
|
# ggplot2::geom_hline(yintercept = 0) +
|
|
# ggplot2::coord_flip() +
|
|
# ggplot2::scale_fill_manual(values = cols) +
|
|
# # REF: https://stackoverflow.com/a/22517219/21019325
|
|
# ggplot2::guides(fill = ggplot2::guide_legend(reverse = TRUE)) +
|
|
# ggplot2::ylab("OR (log))") +
|
|
# ggplot2::labs(
|
|
# fill = "Model" # ,
|
|
# # title = "Prediction models: increase and decrease after stroke",
|
|
# # subtitle = "Median coeficient after cross validation"
|
|
# ) +
|
|
# ggplot2::theme_classic(11) +
|
|
# ggplot2::theme(
|
|
# axis.title.x = ggplot2::element_text(),
|
|
# axis.title.y = ggplot2::element_blank(),
|
|
# axis.text.y = ggplot2::element_blank(),
|
|
# axis.line.y = ggplot2::element_blank(),
|
|
# axis.ticks.y = ggplot2::element_blank() # ,
|
|
# # legend.position = "none"
|
|
# )
|
|
# p1
|
|
|
|
# df_plot <- df_long |>
|
|
# dplyr::mutate(
|
|
# id = seq_len(dplyr::n()),
|
|
# dplyr::across(where(is.numeric), \(.i) signif(.i, digits = 2))
|
|
# ) |>
|
|
# (function(.x) {
|
|
# split(.x, .x[["variable"]]) |>
|
|
# purrr::map(function(.y) {
|
|
# .y |> dplyr::mutate(id = rev(id))
|
|
# }) |>
|
|
# dplyr::bind_rows()
|
|
# })() |>
|
|
# dplyr::mutate(id = rev(id)) |>
|
|
# (function(.z) {
|
|
# .z |> dplyr::mutate(var_label = variable |> (function(.x) {
|
|
# split(.z, .x) |>
|
|
# purrr::map(function(.y) {
|
|
# c("", unique(as.character(.y[[1]])))
|
|
# }) |>
|
|
# purrr::list_c()
|
|
# })())
|
|
# })() |>
|
|
# dplyr::mutate(val_label = paste("OR:", value))
|
|
|
|
|
|
|
|
# df_plot <- df_long |>
|
|
# dplyr::mutate(
|
|
# id = seq_len(dplyr::n()),
|
|
# dplyr::across(where(is.numeric), \(.i) signif(.i, digits = 2))
|
|
# ) |>
|
|
# (function(.x) {
|
|
# split(.x, .x[["variable"]]) |>
|
|
# purrr::map(function(.y) {
|
|
# .y |> dplyr::mutate(id = rev(id))
|
|
# }) |>
|
|
# dplyr::bind_rows()
|
|
# })() |>
|
|
# dplyr::mutate(id = rev(id)) |>
|
|
# (function(.z) {
|
|
# .z |> dplyr::mutate(var_label = variable |> (function(.x) {
|
|
# split(.z, .x) |>
|
|
# purrr::map(function(.y) {
|
|
# c("", unique(as.character(.y[[1]])))
|
|
# }) |>
|
|
# purrr::list_c()
|
|
# })())
|
|
# })() |>
|
|
# dplyr::mutate(val_label = paste("OR:", value))
|
|
#
|
|
# table_text_size <- 5
|
|
# title_text_size <- 20
|
|
# column_space <- c(0, .6)
|
|
#
|
|
# t1 <- df_plot |> ggplot2::ggplot(ggplot2::aes(x = var, y = variable)) +
|
|
# ggplot2::annotate("text",
|
|
# x = column_space[1], y = df_plot$variable,
|
|
# label = df_plot[[5]], hjust = 0, size = table_text_size
|
|
# ) +
|
|
# # ggplot2::annotate("text",
|
|
# # x = column_space[2], y = df_plot$id,
|
|
# # label = df_plot[[2]], hjust = 0, size = table_text_size
|
|
# # ) +
|
|
# ggplot2::annotate("text",
|
|
# x = column_space[2], y = df_plot$variable,
|
|
# label = df_plot[[6]], hjust = 0, size = table_text_size
|
|
# ) +
|
|
# ggplot2::xlim(0, .8) +
|
|
# ggplot2::theme_classic(14) +
|
|
# ggplot2::theme(
|
|
# axis.title.x = ggplot2::element_text(colour = "white"),
|
|
# axis.text.x = ggplot2::element_text(colour = "white"),
|
|
# axis.title.y = ggplot2::element_blank(),
|
|
# axis.text.y = ggplot2::element_blank(),
|
|
# axis.ticks.y = ggplot2::element_blank(),
|
|
# line = ggplot2::element_blank()
|
|
# )
|
|
#
|
|
# patchwork::wrap_plots(t1,
|
|
# p1,
|
|
# ncol = 2, widths = c(1, 1.5)
|
|
# ) + patchwork::plot_annotation(title = "Prediction models: decrease and increase PA")
|
|
#
|
|
#
|
|
# gridExtra::grid.arrange(t1,
|
|
# p1,
|
|
# ncol = 2,
|
|
# widths = c(1, 1.5),
|
|
# top = grid::textGrob("Prediction models: decrease and increase PA",
|
|
# x = 0.02, y = 0.2, gp = grid::gpar(fontsize = title_text_size),
|
|
# just = "left"
|
|
# )
|
|
# )
|