325 lines
9.9 KiB
R
325 lines
9.9 KiB
R
# 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()
|
|
|