72 lines
2.6 KiB
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")
|
||
|
|
|