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