跨运行时间序列数据的 Raincloud 图

Raincloud plot for time series data across runs

我正在努力按照 **Allen, M., Poggiali, D., Whitaker, K., Marshall, T. R., & Kievit, R. A. (2019)[ 中给出的代码制作雨云图=24=]。 Raincloud plots: a multi-platform tool for robust data visualization. 对应文中提到的图10平行图。我期待在每个时间点都能得到雨云。但无论 x 轴上给定的时间如何,我都会得到集体图。 这是我使用的示例数据;

set.seed(123)
  ID = rep(c("BAU","IMP","SGR","CR"), each=5000)
  Time = rep (c(1:1000), each = 20)
  data <- data.frame( ID, Time,  profits = runif(20000,0,1))

代码如下:

source("https://gist.githubusercontent.com/benmarwick/2a1bb0133ff568cbe28d/raw/fb53bd97121f7f9ce947837ef1a4c65a73bffb3f/geom_flat_violin.R")

    data <- data.frame( ID, Time,  profits = runif(20000,0,1))
      AD<- ggplot(data, aes(x = Time, y = profits, fill = ID)) +
        geom_flat_violin(aes(fill = ID),position = position_nudge(x =.1
                                                                                   , y = 0), adjust = 1.5, trim = FALSE, alpha = .5, colour = NA)+
        geom_point(aes(x = as.numeric(ID)-.15, y =profits, colour = ID
        ),position = position_jitter(width = .05), size = 1, shape = 20)+
        geom_boxplot(aes(x =Time,  y = profits, fill = ID),outlier.shape
                     = NA, alpha = .5, width = .1, colour = "black")+ 
        scale_colour_brewer(palette = "Dark2")+
        scale_fill_brewer(palette = "Dark2")+  theme_classic() + theme(legend.position="top") +
        ggtitle("Profits Across Pysical Experiments")

我得到了以下情节

我需要看看如果为每个时间点绘制这些图会是什么样子。有人可以帮忙吗?

更新:根据下面评论中的代码生成的图表 2

您可能会考虑添加 group = Time %/% 10 或类似于 aes() 的调用,以便每 10 次获得一个单独的雨云图。 %/% 运算符是“整数除法”,它提供除法步骤中最接近的整数。它在这里很有用,可以作为将一系列时间值组合在一起的方法。您也可以使用 group = floor(Time / 10) 之类的东西来达到类似的效果。

单独显示所有 1000 次(例如 group = Time)似乎很难辨别:

编辑:这是 25 个雨云的相关代码行,每个 40 个时间步长:

ggplot(data, aes(x = Time, y = profits, fill = ID, group = Time %/% 40)) +

library(tidyverse)
source("https://gist.githubusercontent.com/benmarwick/2a1bb0133ff568cbe28d/raw/fb53bd97121f7f9ce947837ef1a4c65a73bffb3f/geom_flat_violin.R")
raincloud_theme <- theme(
  text = element_text(size = 10),
  axis.title.x = element_text(size = 16),
  axis.title.y = element_text(size = 16),
  axis.text = element_text(size = 14),
  axis.text.x = element_text(angle = 45, vjust = 0.5),
  legend.title = element_text(size = 16),
  legend.text = element_text(size = 16),
  legend.position = "right",
  plot.title = element_text(lineheight = .8, face = "bold", size = 16),
  panel.border = element_blank(),
  panel.grid.minor = element_blank(),
  panel.grid.major = element_blank(),
  axis.line.x = element_line(colour = "black", size = 0.5, linetype = "solid"),
  axis.line.y = element_line(colour = "black", size = 0.5, linetype = "solid"))

set.seed(123)
ID = rep(c("BAU","IMP","SGR","CR"), each=5000)
Time = rep (c(1:1000), each = 20)
data <- data.frame( ID, Time,  profits = runif(20000,0,1))

data %>%
  mutate(TIME = ((Time - 1) %/% 40) + 1,
         TIME = factor(TIME)) %>%
  ggplot(aes(x = TIME, y = profits, fill = ID)) +
  geom_flat_violin(aes(fill = ID),
                   position = position_nudge(x =.1, 
                                             y = 0), 
                   adjust = 1.5, trim = FALSE, alpha = .5, colour = NA) +
  geom_point(aes(x = as.numeric(ID)-.15, y =profits),
             position = position_jitter(width = .05), size = 1, shape = 20) +
  geom_boxplot(aes(x =TIME,  y = profits, fill = ID),outlier.shape
               = NA, alpha = .5, width = .1, colour = "black") + 
  coord_flip() +
  scale_colour_brewer(palette = "Dark2")+
  scale_fill_brewer(palette = "Dark2")+  theme_classic() + theme(legend.position="top") +
  ggtitle("Profits Across Pysical Experiments") +
    raincloud_theme
#> Warning in FUN(X[[i]], ...): NAs introduced by coercion
#> Warning in min(x): no non-missing arguments to min; returning Inf
#> Warning in max(x): no non-missing arguments to max; returning -Inf
#> Warning: Removed 20000 rows containing missing values (geom_point).

reprex package (v2.0.0)

于 2021-08-10 创建