PhysicalActivityandStrokeOu.../1 PA Decline/archive/generation_1/sankey.R

72 lines
2.6 KiB
R

#
# Sankey plot of quartile movement for drops
#
gth<-X_tbl[,c("pase_0_cut","pase_6_cut","pase_drop_fac")]
gth$pase_drop_fac <- factor(ifelse(gth$pase_0_cut=="1",
"low",
gth$pase_drop_fac),
labels = c("no","yes","low")) # Tried and tried to do vectorised, but failed. Matrices acting up..
# Visuals - sankey
# https://stackoverflow.com/questions/50395027/beautifying-sankey-alluvial-visualization-using-r
## Painting
# LOOK AT THIS GREAT FUNCTION!! Wide pivot format. Includes factor for possible quartile-colouring.
df<-data.frame(gth %>% count(pase_0_cut,pase_6_cut,pase_drop_fac))
lbs0<-c(paste0("1st\n(n=",sum(df$n[df[1]=="1"]),")"),
paste0("2nd\n(n=",sum(df$n[df[1]=="2"]),")"),
paste0("3rd\n(n=",sum(df$n[df[1]=="3"]),")"),
paste0("4th\n(n=",sum(df$n[df[1]=="4"]),")"))
lbs6<-c(paste0("1st\n(n=",sum(df$n[df[2]=="1"]),")"),
paste0("2nd\n(n=",sum(df$n[df[2]=="2"]),")"),
paste0("3rd\n(n=",sum(df$n[df[2]=="3"]),")"),
paste0("4th\n(n=",sum(df$n[df[2]=="4"]),")"))
df[1:2] <- as_factor(df[1:2])
levels(df[,1])<-lbs0[1:length(levels(df[,1]))]
levels(df[,2])<-lbs6[1:length(levels(df[,2]))]
df[,3]<-factor(df[,3],levels=c("low","no","yes"))
lows <- "grey80" # grey
drops <- "#990033" # Midtrød
nos <- "grey50"
nas <- "grey90"
border<- "#66c1a3"
box <- "#7fccb2"
cls <- c(lows,nos,drops)
alpha <- 0.7
library(ggalluvial)
(p_delta<-ggplot(df,aes(y = n, axis1 = pase_0_cut, axis2 = pase_6_cut)) +
geom_alluvium(aes(fill = pase_drop_fac, color=pase_drop_fac), width = 1/10, alpha = alpha, knot.pos = 0.3)+
geom_stratum(width = 1/6, fill = box, color = border) +
geom_text(stat = "stratum", aes(label=after_stat(stratum))) +
scale_x_continuous(breaks = 1:2, labels = c("Pre-stroke\nPASE score\nquartiles", "Six months\nPASE score\nquartiles")) +
scale_fill_manual(values = cls) +
scale_color_manual(values = cls) +
scale_y_reverse() + # Easy solution to flip y-axis
labs(title="Change in physical activity") +
ylab("Quartiles")+
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, size = 20, face = "bold")))
ggsave("sankey.png", plot = last_plot(), device = NULL, path = NULL,
scale = 1, width = 120, height = 200, dpi = 450, limitsize = TRUE,
units = "mm")