transfer from old repo
This commit is contained in:
parent
cfa4a5f9cc
commit
277e2b8cf3
1111 changed files with 83736 additions and 0 deletions
173
2 Longterm/hr coef plot.R
Normal file
173
2 Longterm/hr coef plot.R
Normal file
|
|
@ -0,0 +1,173 @@
|
|||
source(here::here("1 PA Decline/dst import.R"))
|
||||
|
||||
file <- project.aid::docx2list("/Users/au301842/Library/CloudStorage/OneDrive-Personal/Research/PhD/2 TALOS opfølgning/Manuskript/Arkiv/Longterm risk_v1_0.docx", data.type = "table cell")
|
||||
|
||||
ds <- file |>
|
||||
purrr::pluck(3) |>
|
||||
(\(.x){
|
||||
setNames(.x, letters[seq_len(ncol(.x))])
|
||||
})() |>
|
||||
dplyr::filter(dplyr::row_number() <= dplyr::n() - 1) |>
|
||||
setNames(c("var", purrr::map(1:3, \(.x)paste0(c("hr", "ci"), .x)) |> purrr::list_c())) |>
|
||||
dplyr::mutate(dplyr::across(dplyr::everything(), ~ gsub("—", "", .x))) |>
|
||||
(\(.x){
|
||||
split.default(.x, factor(project.aid::str_extract(names(.x), "\\d$"), labels = c("Univariable", "Multivariable", "Imputed"))) |>
|
||||
purrr::imap(\(.y, .i){
|
||||
dplyr::bind_cols(var = .x[1], .y) |>
|
||||
tidyr::separate_wider_delim(
|
||||
col = dplyr::starts_with("ci"),
|
||||
delim = ", ",
|
||||
# names_sep = "_",
|
||||
too_few = "align_start",
|
||||
names = c("low", "high")
|
||||
) |>
|
||||
(\(.z){
|
||||
names(.z)[2] <- "hr"
|
||||
.z
|
||||
# setNames(c("var","hr","low","high"))
|
||||
})() |>
|
||||
dplyr::mutate(model = .i)
|
||||
})
|
||||
})() |>
|
||||
dplyr::bind_rows()
|
||||
|
||||
create_log_tics <- function(data) {
|
||||
sort(round(unique(c(1 / data, data)), 2))
|
||||
}
|
||||
|
||||
forest_plot <- function(data,
|
||||
group.colors = viridisLite::viridis(3,option = "D"),
|
||||
x.tics = create_log_tics(c(1, 1.5, 3, 6)),
|
||||
point.shape = rep(23, 3),
|
||||
legend.title = "",
|
||||
dodge.width = .8,
|
||||
wrap.col) {
|
||||
|
||||
data |>
|
||||
ggplot2::ggplot(ggplot2::aes(x = log(hr), y = labels, color = model, fill = model)) +
|
||||
ggplot2::geom_vline(ggplot2::aes(xintercept = 0), linewidth = .5, linetype = "dashed") +
|
||||
ggplot2::geom_point(ggplot2::aes(shape = model),
|
||||
# position = ggplot2::position_dodge(width = dodge.width),
|
||||
size = 7
|
||||
) +
|
||||
ggplot2::geom_errorbarh(ggplot2::aes(xmax = log(high), xmin = log(low)),
|
||||
# position = ggplot2::position_dodge(width = dodge.width),
|
||||
size = .5,
|
||||
height = .2,
|
||||
color = "gray50"
|
||||
) +
|
||||
# ggplot2::position_dodge(width = 2, preserve = "total")+
|
||||
ggplot2::scale_x_continuous(
|
||||
breaks = log(x.tics),
|
||||
labels = x.tics,
|
||||
limits = log(range(x.tics))
|
||||
) +
|
||||
ggplot2::scale_color_manual(values = group.colors) +
|
||||
ggplot2::scale_fill_manual(values = group.colors) +
|
||||
ggplot2::scale_shape_manual(values = point.shape) +
|
||||
ggplot2::theme_bw() +
|
||||
ggplot2::theme(
|
||||
panel.grid.minor = ggplot2::element_blank(),
|
||||
# legend.title = ggplot2::element_text(""),
|
||||
legend.position = "bottom"
|
||||
) +
|
||||
ggplot2::ylab("") +
|
||||
ggplot2::xlab("Hazards ratio (log)") +
|
||||
ggplot2::labs(
|
||||
shape = legend.title,
|
||||
color = legend.title,
|
||||
fill = legend.title
|
||||
) +
|
||||
ggplot2::facet_wrap(facets = ggplot2::vars(model), ncol = wrap.col)
|
||||
}
|
||||
|
||||
# LETTERS[1:8] |> purrr::map(\(.x){
|
||||
# viridisLite::viridis(3,option = .x)|>
|
||||
# project.aid::color_plot(ncol = 3)
|
||||
# }) |> patchwork::wrap_plots(ncol=1)
|
||||
|
||||
headers <- c("Clinical data","Lifestyle factors","Socioeconomic factors","Assessments at follow-up")
|
||||
|
||||
ds_new <- ds |>
|
||||
dplyr::mutate(dplyr::across(c("hr", "low", "high"), ~ as.numeric(.x)),
|
||||
var = factor(var, levels = rev(unique(var))),
|
||||
model = factor(model, levels = unique(model))
|
||||
) |>
|
||||
dplyr::mutate(level=apply(is.na(dplyr::pick(hr,low,high))|dplyr::pick(hr,low,high) == "",1,sum),
|
||||
labels=dplyr::case_when(level==3&var%in%headers~marquee::marquee_glue("**{var}**"),
|
||||
level==3&var!="Body mass index"~marquee::marquee_glue("*{var}*"),
|
||||
.default=marquee::marquee_glue("{var}")),
|
||||
labels = factor(labels, levels = rev(unique(labels))))
|
||||
|
||||
(p1 <- ds_new |> (\(.x){
|
||||
forest_plot(.x, wrap.col = length(levels(.x$model)))
|
||||
})()+
|
||||
ggplot2::theme(axis.text.y =marquee::element_marquee(vjust = .77,
|
||||
# hjust = -1,
|
||||
size=14)))
|
||||
|
||||
|
||||
ggplot2::ggsave(
|
||||
filename = here::here("2 Longterm/hr_plot_facets.png"),
|
||||
plot = p1+
|
||||
ggplot2::theme(
|
||||
strip.background = ggplot2::element_blank(),
|
||||
strip.text.x = ggplot2::element_blank(),
|
||||
legend.text = ggplot2::element_text(size=14),
|
||||
axis.text.x=ggplot2::element_text(size=10),
|
||||
axis.ticks.length.y = ggplot2::unit(3,"mm"),
|
||||
axis.ticks.y = ggplot2::element_line(color = "white")
|
||||
),
|
||||
units = "mm",
|
||||
width = 250,
|
||||
height = 300,
|
||||
# pointsize = 10,
|
||||
dpi = 300,
|
||||
)
|
||||
|
||||
|
||||
headers <- c("Clinical data","Lifestyle factors","Socioeconomic factors","Assessments at follow-up")
|
||||
|
||||
(t <- ds |>
|
||||
dplyr::mutate(dplyr::across(dplyr::everything(), ~ gsub("—", "", .x))) |>
|
||||
dplyr::mutate(dplyr::across(c("hr", "low", "high"), ~ as.numeric(.x)),
|
||||
var = factor(var, levels = rev(unique(var))),
|
||||
model = factor(model, levels = unique(model))
|
||||
) |>
|
||||
dplyr::mutate(level=apply(is.na(dplyr::pick(hr,low,high))|dplyr::pick(hr,low,high) == "",1,sum),
|
||||
labels=dplyr::case_when(level==3&var%in%headers~glue::glue("**{var}**"),
|
||||
level==3~glue::glue("*{var}*"),
|
||||
.default=glue::glue("{var}"))) |>
|
||||
dplyr::filter(model=="Univariable") |>
|
||||
ggplot2::ggplot(
|
||||
# ggplot2::aes(x = x, y = var)
|
||||
) +
|
||||
ggtext::geom_richtext(ggplot2::aes(x = 0, y = var,label = labels),fill = NA,
|
||||
label.colour = NA,
|
||||
hjust="right") +
|
||||
ggplot2::scale_x_continuous(
|
||||
limits = c(-.1,0)
|
||||
)+
|
||||
ggplot2::theme_void())
|
||||
|
||||
(w <- patchwork::wrap_plots(list(t,
|
||||
# patchwork::plot_spacer(),
|
||||
p1+
|
||||
ggplot2::theme(
|
||||
strip.background = ggplot2::element_blank(),
|
||||
strip.text.x = ggplot2::element_blank(),
|
||||
axis.text.y = ggplot2::element_blank(),
|
||||
plot.margin = ggplot2::unit(c(1,1,1,0), 'cm'),
|
||||
# axis.ticks.y.length = ggplot2::unit(0, "pt"),
|
||||
# axis.ticks.y = ggplot2::element_blank(),
|
||||
# panel.border=ggplot2::element_blank(),
|
||||
panel.spacing = ggplot2::unit(0, "cm")
|
||||
)),ncol=2,widths = c(1.2,3),axes = "collect"))
|
||||
|
||||
ggplot2::ggsave(
|
||||
filename = here::here("2 Longterm/hr_plot_facets_labels.png"),plot = w,
|
||||
units = "mm",
|
||||
width = 200,
|
||||
height = 220,
|
||||
dpi = 300,
|
||||
)
|
||||
Loading…
Reference in a new issue