之前给大家分享了肿瘤领域常用的泳道图的画法：
用ggplot2画肿瘤领域常见的泳道图
图画出来了，基本符合要求，但是有一个小小的问题：箭头表示的信息没有展示出来。
众所周知，R语言里自带的形状是没有箭头的。
在这篇文章[1]中找到了答案，可以用Unicode符号。
我们还是用上次用过的df数据继续演示。
suppressMessages(library(tidyverse))
set.seed(200)
df <- data.frame(Patient = 1:12,
Months = sample(6:30, 12, replace=TRUE),
Stage = sample(1:4, 12, replace=TRUE),
Continued = sample(0:1, 12, replace=TRUE))
df <- df |>
group_by(Patient) |>
mutate('Complete Response Start'=sample(c(6:(max(Months)-1),NA), 1,
prob=c(rep(1, length(6:(max(Months)-1))),5), replace=TRUE),
'Partial Response Start'=sample(c(6:(max(Months)-1),NA), 1,
prob=c(rep(1, length(6:(max(Months)-1))),5), replace=TRUE),
'Durable'=sample(c(-0.5,NA), 1, replace=TRUE),
'Response End'=sample(c(6:(max(Months)-1),NA), 1,
prob=c(rep(1, length(6:(max(Months)-1))),5), replace=TRUE)
)
# 数据大概这样
head(df)
## # A tibble: 6 × 8
## # Groups: Patient [6]
## Patient Months Stage Continued Complete Response Sta…¹ Parti…² Durable Respo…³
## <int> <int> <int> <int> <int> <int> <dbl> <int>
## 1 1 11 1 1 10 8 -0.5 NA
## 2 2 23 4 1 18 14 -0.5 17
## 3 3 20 2 0 NA NA -0.5 NA
## 4 4 13 3 0 6 NA -0.5 12
## 5 5 28 4 0 9 NA NA 23
## 6 6 17 4 0 NA 11 NA 9
## # … with abbreviated variable names ¹`Complete Response Start`,
## # ²`Partial Response Start`, ³`Response End`
变为长数据：
代码语言：javascript复制df_long <- df |>
mutate(Continued = case_when(Continued == 1 ~ Months 0.5)) |>
pivot_longer(4:8,names_to = "type",values_to = "value")
df_long$type <- factor(df_long$type,levels = c("Complete Response Start",
"Partial Response Start",
"Response End",
"Durable",
"Continued"))
head(df_long)
## # A tibble: 6 × 5
## # Groups: Patient [2]
## Patient Months Stage type value
## <int> <int> <int> <fct> <dbl>
## 1 1 11 1 Continued 11.5
## 2 1 11 1 Complete Response Start 10
## 3 1 11 1 Partial Response Start 8
## 4 1 11 1 Durable -0.5
## 5 1 11 1 Response End NA
## 6 2 23 4 Continued 23.5
p1 <- ggplot(df, aes(Months, fct_reorder(factor(Patient),Months)))
geom_bar(stat = "identity", aes(fill=factor(Stage)), width = 0.7)
geom_point(data = df_long,
aes(value, fct_reorder(factor(Patient),Months),color=type,shape=type),
size = 5
)
p1
plot of chunk unnamed-chunk-9
这个网站：https://unicode-table.com/en/blocks/， 可以挑选各种Unicode符号，解锁新形状，应有尽有，再也不怕找不到合适的符号了！
代码语言：javascript复制unicode = list(triangle=sprintf('u25B2'),
circle=sprintf('u25CF'),
square=sprintf('u25A0'),
arrow=sprintf('u2794'))
改变符号：
代码语言：javascript复制p2 <- p1
scale_shape_manual(values=c(rep(unicode[["triangle"]], 2),
unicode[["circle"]], unicode[["square"]], unicode[["arrow"]]))
scale_colour_manual(values=c(RColorBrewer::brewer.pal(3, "Set1")[1:2],
rep("black", 3)))
scale_x_continuous(limits = c(-1,32), breaks = -1:30,expand = c(0,0.6))
labs(fill = "Disease Stage", shape = NULL, color = NULL,y="Patient")
theme_bw()
theme(panel.grid.minor=element_blank(),
panel.grid.major=element_blank(),
axis.text.y=element_blank(),
axis.ticks.y=element_blank()
)
p2
plot of chunk unnamed-chunk-11
搞定，但是还有问题，箭头不在正中间，大家有解决办法吗？
参考资料
[1]
unicode: https://rpubs.com/alexiswl/swimmer
