transfer from old repo
This commit is contained in:
parent
cfa4a5f9cc
commit
277e2b8cf3
1111 changed files with 83736 additions and 0 deletions
325
1 PA Decline/article sankey.R
Normal file
325
1 PA Decline/article sankey.R
Normal file
|
|
@ -0,0 +1,325 @@
|
|||
# source("1 PA Decline/data_format.R")
|
||||
|
||||
# NEW QUARTILES
|
||||
|
||||
ds <- readr::read_csv(here::here("/Volumes/Data/REDCap/DDV/talos_ddv.csv"))
|
||||
|
||||
df_raw <- ds |>
|
||||
dplyr::filter(!pase_score_missings_0, !pase_score_missings_4) |>
|
||||
dplyr::transmute(
|
||||
pase_0_cut = as.numeric(stRoke::quantile_cut(x = pase_score_sum_0,
|
||||
groups = 4,
|
||||
group.names = paste0(1:4))),
|
||||
pase_6_cut = as.numeric(stRoke::quantile_cut(x = pase_score_sum_4,
|
||||
y = pase_score_sum_0,
|
||||
groups = 4,
|
||||
inc.outs = TRUE,
|
||||
group.names = paste0(1:4))),
|
||||
change = dplyr::case_when(
|
||||
pase_0_cut %in% 2:4 & pase_6_cut == 1 ~ "drop",
|
||||
pase_6_cut %in% 2:4 & pase_0_cut == 1 ~ "hop",
|
||||
pase_0_cut %in% 2:4 & pase_6_cut %in% 2:4 ~ "hh",
|
||||
pase_0_cut %in% 1 & pase_6_cut == 1 ~ "ll"
|
||||
)
|
||||
,
|
||||
change_any = factor(dplyr::case_when(
|
||||
pase_6_cut > pase_0_cut ~ "hop",
|
||||
pase_6_cut < pase_0_cut ~ "drop",
|
||||
pase_0_cut %in% 2:4 & pase_6_cut %in% 2:4 ~ "hh",
|
||||
pase_0_cut %in% 1 & pase_6_cut == 1 ~ "ll"
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
|
||||
# Visuals - sankey
|
||||
# https://stackoverflow.com/questions/50395027/beautifying-sankey-alluvial-visualization-using-r
|
||||
|
||||
|
||||
## Painting
|
||||
|
||||
sankey_ready <- function(data,change.var="change"){
|
||||
df <- data |>
|
||||
dplyr::count(dplyr::across(dplyr::all_of(c("pase_0_cut", "pase_6_cut",change.var)))) |>
|
||||
dplyr::mutate(dplyr::across(dplyr::starts_with("pase_"),\(.x) factor(.x))) |>
|
||||
setNames(c("pase_0_cut", "pase_6_cut","change","n"))
|
||||
|
||||
lbs0 <-
|
||||
c(
|
||||
paste0("1st \n(n=", sum(df$n[df$pase_0_cut == "1"]), ")"),
|
||||
paste0("2nd \n(n=", sum(df$n[df$pase_0_cut == "2"]), ")"),
|
||||
paste0("3rd \n(n=", sum(df$n[df$pase_0_cut == "3"]), ")"),
|
||||
paste0("4th \n(n=", sum(df$n[df$pase_0_cut == "4"]), ")")
|
||||
)
|
||||
|
||||
|
||||
lbs6 <-
|
||||
c(
|
||||
paste0("1st \n(n=", sum(df$n[df$pase_6_cut == "1"]), ")"),
|
||||
paste0("2nd \n(n=", sum(df$n[df$pase_6_cut == "2"]), ")"),
|
||||
paste0("3rd \n(n=", sum(df$n[df$pase_6_cut == "3"]), ")"),
|
||||
paste0("4th \n(n=", sum(df$n[df$pase_6_cut == "4"]), ")")
|
||||
)
|
||||
|
||||
|
||||
levels(df$pase_0_cut) <- lbs0[1:length(levels(df$pase_0_cut))]
|
||||
levels(df$pase_6_cut) <- lbs6[1:length(levels(df$pase_6_cut))]
|
||||
|
||||
df$pase_0_cut <- factor(df$pase_0_cut, levels = rev(levels(df$pase_0_cut)))
|
||||
df$pase_6_cut <- factor(df$pase_6_cut, levels = rev(levels(df$pase_6_cut)))
|
||||
|
||||
df$change <- factor(df$change, levels = c("hh","hop", "drop", "ll"))
|
||||
|
||||
if (change.var=="change"){
|
||||
df |> dplyr::mutate(first_grp=ifelse(substr(pase_0_cut,1,1)==1,"low","higher"))
|
||||
} else if (change.var=="change_any"){
|
||||
df |> dplyr::mutate(first_grp=dplyr::case_when(
|
||||
substr(pase_0_cut,1,1)==1 ~ "low",
|
||||
substr(pase_0_cut,1,1) %in% 2:3 ~ "mid",
|
||||
substr(pase_0_cut,1,1)==4 ~ "high"))
|
||||
}
|
||||
}
|
||||
|
||||
# hops <- "#66c1a3" # grey
|
||||
# # drops <- "#990033" # Midtrød
|
||||
# drops <- "#CE0045" # Lighter Midtrød
|
||||
# nos <- "grey80" # Light grey
|
||||
#
|
||||
# # border <- "#00596B"
|
||||
# # box <- "#008099"
|
||||
#
|
||||
# border <- "#EA571D"
|
||||
# box <- "#1E4B66"
|
||||
#
|
||||
# higher <- "yellow"
|
||||
# low <- "purple"
|
||||
|
||||
library(ggalluvial)
|
||||
|
||||
library(ggplot2)
|
||||
|
||||
# stRoke::color_plot(viridisLite::turbo (4))
|
||||
|
||||
plot_sankey <- function(data,
|
||||
# palette=viridisLite::turbo(4),
|
||||
hops = "#66c1a3",
|
||||
drops = "#CE0045",
|
||||
hh = "#fcdc9c",
|
||||
ll = "#fcdc9c",
|
||||
border = "#EA571D",
|
||||
box = "#1E4B66",
|
||||
higher = "#2986cc",
|
||||
mid = "#b4a7d6",
|
||||
low = "#590075",
|
||||
alpha = 0.8,
|
||||
a1=pase_0_cut,
|
||||
a2=pase_6_cut,
|
||||
a1.grp=first_grp,
|
||||
text.size = 4
|
||||
){
|
||||
|
||||
if (length(unique(data[[ncol(data)]]))>2) {
|
||||
fills <- c(higher,low,mid)
|
||||
} else {
|
||||
fills <- c(higher,low)
|
||||
}
|
||||
|
||||
cls <- c(hh, hops, drops, ll)
|
||||
# stratum.grp <- c(df[["first_grp"]],df[["last_grp"]])
|
||||
|
||||
# cls <- palette
|
||||
# browser()
|
||||
ggplot(data, aes(y = n, axis1 = {{a1}}, axis2 = {{a2}})) +
|
||||
geom_alluvium(
|
||||
aes(fill = change, color = change),
|
||||
width = 1 / 16,
|
||||
alpha = alpha,
|
||||
knot.pos = 0.4,
|
||||
curve_type ="sigmoid"
|
||||
) +
|
||||
geom_stratum(aes(fill={{a1.grp}}),
|
||||
# geom_stratum(aes(fill=stratum_grp),
|
||||
size = 2,
|
||||
width = 1 / 3.4,
|
||||
# fill = box,
|
||||
color = border
|
||||
) +
|
||||
geom_text(stat = "stratum",
|
||||
aes(label = after_stat(stratum)),
|
||||
colour = "white",
|
||||
size = text.size,
|
||||
lineheight = 1) +
|
||||
scale_x_continuous(
|
||||
breaks = 1:2,
|
||||
labels = c("Pre-stroke\nPASE quartile", "Six months\nPASE quartile")
|
||||
) +
|
||||
scale_fill_manual(values = c(cls,fills),na.value = box) +
|
||||
scale_color_manual(values = cls) +
|
||||
ggtitle("PA level changes from \npre-stroke to post-stroke")
|
||||
}
|
||||
|
||||
## Changes to left colum coloring is needed.
|
||||
|
||||
c("change","change_any") |> purrr::map(\(.x){
|
||||
df_raw |>
|
||||
sankey_ready(change.var = .x)
|
||||
}) |>
|
||||
purrr::map(\(.x){
|
||||
.x |> plot_sankey(text.size=4.5)
|
||||
}) |>
|
||||
patchwork::wrap_plots()
|
||||
|
||||
|
||||
|
||||
p_delta <- df_raw |>
|
||||
sankey_ready() |>
|
||||
plot_sankey(text.size=4.5)
|
||||
|
||||
|
||||
# plotly::ggplotly(p_delta)
|
||||
|
||||
# png(
|
||||
# filename = "sankey_change_ARTICLEA.png",
|
||||
# units = "mm",
|
||||
# width = 500,
|
||||
# height = 600,
|
||||
# pointsize = 60,
|
||||
# res = 300
|
||||
# )
|
||||
ggplot2::ggsave(filename = "1 PA Decline/sankey_change_ARTICLEA_ejn.png",
|
||||
p_delta +
|
||||
theme_void() +
|
||||
theme(
|
||||
legend.position = "none",
|
||||
# panel.grid.major = element_blank(),
|
||||
# panel.grid.minor = element_blank(),
|
||||
# axis.text.y = element_blank(),
|
||||
# axis.title.y = element_blank(),
|
||||
axis.text.x = element_text(),
|
||||
# text = element_text(size = 5),
|
||||
plot.title = element_blank(),
|
||||
# panel.background = element_rect(fill = "white"),
|
||||
plot.background = element_rect(fill="white"),
|
||||
panel.border = element_blank()
|
||||
),
|
||||
units = "mm",
|
||||
width = 84,
|
||||
height = 70,
|
||||
# pointsize = 30,
|
||||
dpi = 600)
|
||||
#
|
||||
#
|
||||
ggplot2::ggsave(filename = "1 PA Decline/sankey_change_ARTICLEA.png",
|
||||
p_delta +
|
||||
theme_void() +
|
||||
theme(
|
||||
legend.position = "none",
|
||||
# panel.grid.major = element_blank(),
|
||||
# panel.grid.minor = element_blank(),
|
||||
# axis.text.y = element_blank(),
|
||||
# axis.title.y = element_blank(),
|
||||
axis.text.x = element_text(),
|
||||
text = element_text(size = 20),
|
||||
plot.title = element_blank(),
|
||||
# panel.background = element_rect(fill = "white"),
|
||||
plot.background = element_rect(fill="white"),
|
||||
panel.border = element_blank()
|
||||
),
|
||||
units = "mm",
|
||||
width = 200,
|
||||
height = 220,
|
||||
# pointsize = 30,
|
||||
dpi = 600)
|
||||
|
||||
ggplot2::ggsave(filename = "1 PA Decline/sankey_change_ARTICLEA.pdf",
|
||||
p_delta +
|
||||
theme_void() +
|
||||
theme(
|
||||
legend.position = "none",
|
||||
# panel.grid.major = element_blank(),
|
||||
# panel.grid.minor = element_blank(),
|
||||
# axis.text.y = element_blank(),
|
||||
# axis.title.y = element_blank(),
|
||||
axis.text.x = element_text(),
|
||||
text = element_text(size = 20),
|
||||
plot.title = element_blank(),
|
||||
# panel.background = element_rect(fill = "white"),
|
||||
plot.background = element_rect(fill="white"),
|
||||
panel.border = element_blank()
|
||||
),
|
||||
units = "mm",
|
||||
width = 200,
|
||||
height = 220,
|
||||
# pointsize = 30,
|
||||
dpi = 1200)
|
||||
|
||||
# png(
|
||||
# filename = "sankey_change_PhDDay.png",
|
||||
# units = "mm",
|
||||
# width = 100,
|
||||
# height = 200,
|
||||
# pointsize = 15,
|
||||
# res = 300
|
||||
# )
|
||||
# p_delta +
|
||||
# theme_minimal() +
|
||||
# theme(
|
||||
# legend.position = "none",
|
||||
# panel.grid.major = element_blank(),
|
||||
# panel.grid.minor = element_blank(),
|
||||
# axis.text.y = element_blank(),
|
||||
# axis.title.y = element_blank(),
|
||||
# axis.text.x = element_text(size = 14, face = "bold"),
|
||||
# plot.title = element_text(hjust = 0.5, vjust = 1, size = 30, face = "bold")
|
||||
# )
|
||||
# dev.off()
|
||||
|
||||
|
||||
# png(
|
||||
# filename = "sankey_change_PhDDay_min.png",
|
||||
# units = "mm",
|
||||
# width = 500,
|
||||
# height = 500,
|
||||
# pointsize = 15,
|
||||
# res = 300
|
||||
# )
|
||||
# p_delta +
|
||||
# theme_minimal() +
|
||||
# theme(
|
||||
# legend.position = "none",
|
||||
# panel.grid.major = element_blank(),
|
||||
# panel.grid.minor = element_blank(),
|
||||
# axis.text.y = element_blank(),
|
||||
# axis.title.y = element_blank(),
|
||||
# axis.text.x = element_blank(),
|
||||
# plot.title = element_blank(),
|
||||
# panel.background = element_rect(fill = "transparent"),
|
||||
# plot.background = element_rect(fill = "transparent", color = NA)
|
||||
# )
|
||||
# dev.off()
|
||||
|
||||
|
||||
|
||||
# png(
|
||||
# filename = "sankey_change_ESOC23.png",
|
||||
# units = "mm",
|
||||
# width = 500,
|
||||
# height = 500,
|
||||
# pointsize = 60,
|
||||
# res = 300
|
||||
# )
|
||||
# p_delta +
|
||||
# theme_minimal() +
|
||||
# theme(
|
||||
# legend.position = "none",
|
||||
# panel.grid.major = element_blank(),
|
||||
# panel.grid.minor = element_blank(),
|
||||
# axis.text.y = element_blank(),
|
||||
# axis.title.y = element_blank(),
|
||||
# axis.text.x = element_blank(),
|
||||
# plot.title = element_blank(),
|
||||
# panel.background = element_rect(fill = "transparent"),
|
||||
# plot.background = element_rect(fill = "transparent", color = NA)
|
||||
# )
|
||||
# dev.off()
|
||||
|
||||
Loading…
Reference in a new issue