Блог

Я хочу получить график, подобный этому, имея каждый канал временного ряда ээг ниже другого, используя пространство для построения графика как можно лучше, поскольку имеется 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?

РЕДАКТИРОВАТЬ: добавлен другой подход внизу для более плотной упаковки, если нерегулярный интервал в порядке.

Вот еще один подход, позволяющий вам более тесно сжиматься и допускать перекрытия:

 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="")
 

Вот другой подход, который находит минимально необходимый интервал между каждым рядом, чтобы избежать каких-либо перекрытий.

 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="")
 

Я думаю, вы были довольно близки. Я буду использовать data.table только для получения числа, необходимого для обозначения оси y, но вы можете использовать любой другой инструмент base или 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)
 

Который производит:

Я думаю, что мне удалось получить что-то близкое к первому столбцу, используя фасеты. Чтобы поместить имена фасетов по оси y, используйте strip.position = 'left' функцию facet . Это сэкономит много места.

Затем, чтобы ближе взглянуть на первый столбец, вам нужно поиграть с theme() элементами.

 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')
 

Мой результирующий график