transfer from old repo
This commit is contained in:
parent
cfa4a5f9cc
commit
277e2b8cf3
1111 changed files with 83736 additions and 0 deletions
155
1 PA Decline/sankey.R
Normal file
155
1 PA Decline/sankey.R
Normal file
|
|
@ -0,0 +1,155 @@
|
|||
|
||||
# source("1 PA Decline/data_format.R")
|
||||
|
||||
# NEW QUARTILES
|
||||
|
||||
df <- X_tbl |> select(pase_0_cut,pase_6_cut)
|
||||
|
||||
df$change <- factor(ifelse(
|
||||
df$pase_0_cut %in% 2:4 & df$pase_6_cut == 1,
|
||||
"drop",
|
||||
ifelse(
|
||||
df$pase_6_cut %in% 2:4 & df$pase_0_cut == 1,
|
||||
"hop",
|
||||
"no"
|
||||
)))
|
||||
|
||||
|
||||
# Visuals - sankey
|
||||
# https://stackoverflow.com/questions/50395027/beautifying-sankey-alluvial-visualization-using-r
|
||||
|
||||
|
||||
## Painting
|
||||
|
||||
df <- df |> count(pase_0_cut,pase_6_cut,change)
|
||||
|
||||
|
||||
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("no", "drop", "hop"))
|
||||
|
||||
|
||||
hops <- "#66c1a3" # grey
|
||||
# drops <- "#990033" # Midtrød
|
||||
drops <- "#CE0045" #Lighter Midtrød
|
||||
nos <- "grey90" # Light grey
|
||||
|
||||
# border <- "#00596B"
|
||||
# box <- "#008099"
|
||||
|
||||
border <- "#EA571D"
|
||||
box <- "#1E4B66"
|
||||
|
||||
|
||||
cls <- c(nos, drops, hops)
|
||||
|
||||
alpha <- 0.7
|
||||
|
||||
library(ggalluvial)
|
||||
|
||||
p_delta <- ggplot(df,aes(y = n, axis1 = pase_0_cut, axis2 = pase_6_cut)) +
|
||||
geom_alluvium(
|
||||
aes(fill = change, color = change),
|
||||
width = 1 / 16,
|
||||
alpha = alpha,
|
||||
knot.pos = 0.4
|
||||
) +
|
||||
geom_stratum(aes(size=10),width = 1 / 4,
|
||||
fill = box,
|
||||
color = border) +
|
||||
geom_text(stat = "stratum", aes(label = after_stat(stratum)), colour = "white", size = 20) +
|
||||
scale_x_continuous(breaks = 1:2,
|
||||
labels = c("Pre-stroke\nquartile", "Six months\nquartile")) +
|
||||
scale_fill_manual(values = cls) +
|
||||
scale_color_manual(values = cls) +
|
||||
ggtitle("Change in PA\nafter stroke")
|
||||
|
||||
|
||||
# plotly::ggplotly(p_delta)
|
||||
|
||||
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()
|
||||
|
||||
Loading…
Reference in a new issue