复制颜色编码的意大利面条图

Question

本文中：https://www.nature.com/articles/s41591-022-01744-z.epdf 我注意到一个有趣的情节：

在 R 中有没有一种简单的方法可以做到这一点？

编辑：我知道有类似的问题，但 none 处理标记改进/恶化情况的颜色编码方案。

Answer 1

see 包中有一个像这样的半小提琴几何图形：

ggplot(data = data.frame(id = rep(1:10, 2),
                         time = rep(c("A", "B"), each = 10),
                         value = runif(20)),
       aes(time, value)) +
  see::geom_violinhalf(aes(group = time, fill = time), 
                       trim = FALSE, flip = 1, alpha = 0.2) +
  geom_point(aes(color = time)) +
  geom_line(aes(group = id))

Answer 2

您可以使用 ggplot 任意接近所选图表：

ggplot(df, aes(xval, modularity, color = group)) + 
  geom_polygon(data = densdf, aes( x = y, y = x, fill = group), colour = NA) +
  scale_fill_manual(values = c('#c2c2c2', '#fbc5b4')) +
  scale_color_manual(values = c('#676767', '#ef453e')) +
  geom_path(data = densdf, aes(x = y, y = x), size = 2) +
  geom_segment(color = '#c2c2c2', inherit.aes = FALSE, size = 1.5,
               data = df2[df2$`Post-treatment` > df2$Baseline,], alpha = 0.8,
               aes(x = 1, xend = 2, y = Baseline, yend = `Post-treatment`)) +
  geom_segment(color = '#ef453e', inherit.aes = FALSE, size = 1.5, alpha = 0.8,
               data = df2[df2$`Post-treatment` < df2$Baseline,],
               aes(x = 1, xend = 2, y = Baseline, yend = `Post-treatment`)) +
  geom_point(size = 3) +
  theme_classic() +
  scale_x_continuous(breaks = 1:2, labels = c('Baseline', 'Post-treatment'),
                     name = '', expand = c(0.3, 0)) +
  theme(legend.position = 'none',
        text = element_text(size = 18, face = 2),
        panel.background = element_rect(fill = NA, color = 'black', size = 1.5))

只要您准备好将数据转换为正确的格式：

set.seed(4)
mod <- c(rnorm(16, 2.5, 0.25))

df <- data.frame(modularity = c(mod, mod + rnorm(16, -0.25, 0.2)),
                 xval = rep(c(1, 2), each = 16),
                 group = rep(c('Baseline', 'Post-treatment'), each = 16),
                 id = factor(rep(1:16, 2)))

df2 <- df %>% tidyr::pivot_wider(id_cols = id, names_from = group, 
                                 values_from = modularity)

BLdens <- as.data.frame(density(df$modularity[1:16])[c('x', 'y')])
PTdens <- as.data.frame(density(df$modularity[17:32])[c('x', 'y')])
BLdens$y <- 1 - 0.25 * BLdens$y
PTdens$y <- 2 + 0.25 * PTdens$y
densdf <- rbind(BLdens, PTdens)
densdf$group <- rep(c('Baseline', 'Post-treatment'), each = nrow(BLdens))

复制颜色编码的意大利面条图

Replicating a color-coded spaghetti plot

r

ggplot2

plot

longitudinal