Question

我想获得一个与此图相似的图，将eeg时间序列的每个通道都放在另一个通道之下，同时由于有64个通道，因此要尽可能好地利用绘图空间。这是图片。第1、2和4栏对我很有趣：

目前，我正在使用gg plot和facet wrap，这浪费了标签和轴上的大量空间。像第一个柱状图这样的简单图就足以将不同的通道相互比较。

这是我当前的代码：

library(ggplot2)
library(reshape2)

X1 <- c(1,2,3,4,5,6,7,8,9,19)
X2 <- c(1,4,2,4,1,4,1,4,1,4)
X3 <- c(1,2,3,4,5,6,7,8,9,10)
X4 <- c(1,2,3,4,5,6,7,8,9,1)
X5 <- c(1,4,2,4,1,4,1,4,1,4)
X6 <- c(1,2,3,4,5,6,7,8,9,10)
X7 <- c(1,2,3,4,5,6,7,8,9,11)
X8 <- c(1,4,2,4,1,4,1,4,1,4)
X9 <- c(1,2,3,4,5,6,7,8,9,10)
X10 <- c(1,2,3,4,5,6,7,8,9,10)

icaFrame <- data.frame(X1, X2, X3, X4, X5, X6, X7, X8, X9, X10)

scale <- rep.int(c(1:10),10)


df_melt = melt(icaFrame[,1:10])
ggplot(df_melt, aes(x = scale, y = value)) + 
  geom_line() + 
  facet_wrap(~ variable, scales = 'free_y', ncol = 1)

那么，如何使用R在每个时间序列下方绘制每个时间序列来创建这样一个简单的图？

Answer 1

I think I was able to get something close to the first column using facets. To put the names of the facets in the y axis, use strip.position = 'left' in the facet function. This will save a lot of space.

Then, to get a a look closer to first column, you need to play around with the theme() elements.

library(ggplot2)
library(reshape2)

X1 <- c(1,2,3,4,5,6,7,8,9,19)
X2 <- c(1,4,2,4,1,4,1,4,1,4)
X3 <- c(1,2,3,4,5,6,7,8,9,10)
X4 <- c(1,2,3,4,5,6,7,8,9,1)
X5 <- c(1,4,2,4,1,4,1,4,1,4)
X6 <- c(1,2,3,4,5,6,7,8,9,10)
X7 <- c(1,2,3,4,5,6,7,8,9,11)
X8 <- c(1,4,2,4,1,4,1,4,1,4)
X9 <- c(1,2,3,4,5,6,7,8,9,10)
X10 <- c(1,2,3,4,5,6,7,8,9,10)

icaFrame <- data.frame(X1, X2, X3, X4, X5, X6, X7, X8, X9, X10)

scale <- rep.int(c(1:10),10)

df_melt <- melt(icaFrame[,1:10])

ggplot(df_melt, aes(x = scale, y = value)) + 
  geom_line() + 
  # remove extra space in x axis
  scale_x_continuous(expand=c(0,0)) +
  # standard black and white background theme 
  theme_bw() +
  # customized theme elements (you can play around with them to get a better look:
  theme(axis.title = element_blank(),              # remove labels from axis
        panel.spacing = unit(0, units = 'points'), # remove spacing between facet panels
        panel.border = element_blank(),            # remove border in each facet
        panel.grid.major.y=element_blank(),        # remove grid lines from y axis
        panel.grid.minor.y=element_blank(),
        axis.line = element_line(),                # add axis lines to x and y
        axis.text.y=element_blank(),               # remove tick labels from y axis
        axis.ticks.y = element_blank(),            # remove tick lines from y axis
        strip.background = element_blank(),        # remove gray box from facet title
        # change rotation and alignment of text in facet title
        strip.text.y = element_text(angle = 180,   
                                  face = 'bold',
                                  hjust=1,
                                  vjust=0.5),
        # place facet title to the left of y axis
        strip.placement = 'outside'
        ) +
  # call facet_wrap with argument strip.position = 'left'
  facet_wrap(~ variable, scales = 'free_y', ncol = 1, strip.position = 'left')

My resulting plot

Answer 2

EDIT: Added another approach at the bottom for tighter packing if irregular spacing is ok.

Here's another approach to allow you to squeeze in more closely and allow overlaps:

scaling_factor = 2.5  # Adjust this to make more or less room between series

ggplot(df_melt, aes(x = scale, group = variable,
                    y = value + as.numeric(variable) * scaling_factor)) + 
  geom_line() +
  scale_y_continuous(breaks = (as.numeric(df_melt$variable) + 0.5) * scaling_factor,
                     labels = df_melt$variable, minor_breaks = NULL) +
  labs(y="")

Here's another approach, which finds the minimum necessary spacing between each series to avoid any overlaps.

library(dplyr)
min_space = 2
vertical_shift <- df_melt %>%
  # Add scale as a variable for use in next step
  group_by(variable) %>% mutate(scale = row_number()) %>% ungroup() %>%
  # Group by scale and track gap vs. prior variable
  group_by(scale) %>% mutate(gap = value - lag(value, default = 0)) %>% ungroup() %>%
  # Group by variable and find minimum gap
  group_by(variable) %>% 
  summarize(gap_needed_below = 1 - min(gap) + min_space) %>%
  ungroup() %>%
  mutate(cuml_gap = cumsum(gap_needed_below))

df_melt %>%
  group_by(variable) %>% mutate(scale = row_number()) %>% ungroup() %>%
  left_join(vertical_shift) %>%
  mutate(shifted_value = value + cuml_gap) %>%
ggplot(aes(x = scale, group = variable,
           y = shifted_value)) + 
  geom_line() +
  scale_y_continuous(breaks = vertical_shift_headers$cuml_gap + 1,
                     labels = vertical_shift_headers$variable,
                     minor_breaks = NULL) +
  labs(y="")

Answer 3

我认为您已经很接近了。我将使用data.table来获取标记y轴所需的数字，但是您可以使用任何其他基数或dplyr工具。我还将使用一些虚拟数据，使我们可以更好地查看结果（与粘贴的图像不同，您的数据与值交叉）。

# load libraries

library(data.table)
library(ggplot2)

# create dummy data

set.seed(1)
dt <- data.table(time = 1:10, 
                 EOG = sample(1:5, 10, TRUE), 
                 Pz = sample(6:10, 10, TRUE), 
                 Cz = sample(15:21, 10, TRUE))

# melt that data

melt_dt <- melt(dt, id.vars = 1)

# find mean values for each variable

crossings <- melt_dt[, mean(value), by = variable]

现在，绘制整个图：

ggplot(melt_dt, 
       aes(x = time, 
           y = value, 
           group = variable))+
   geom_line()+
   scale_y_continuous(breaks = crossings$V1, 
                      labels = crossings$variable)

哪个会产生：

使用R在另一个下方绘制多个时间序列

3 个答案: