# 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()