transfer from old repo

1 PA Decline/archive/generation_1/sankey.R

@@ -0,0 +1,72 @@
+#
+# 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")
+