Соединение точек смещенного графика с другим графиком с помощью ggplot в R - PullRequest
Новая
       38

Соединение точек смещенного графика с другим графиком с помощью ggplot в R

1 голос
/ 11 июня 2019

У меня есть два кадра данных df1 и df2 следующим образом: 

> df1
  dateTime value
1        1     6
2        2     2
3        3     3
4        4     1

> df2
  dateTime value
1        1     3
2        2     8
3        3     4
4        4     5

Я хочу построить эти кадры данных на одной диаграмме, разделить их на два разных графика с одинаковой осью x, сместить df1 на 1 вправо и соединить каждое значение df1 с соответствующим значением df2. Вот мой код: 

#Shift df1 by 1 to the right
df1$value <- lag(df1$value, 1)

plot1 <- df1 %>%
  select(dateTime, value) %>%
  ggplot(aes(dateTime, value)) +
  geom_point() +
  geom_line(color = "green") +
  geom_segment(aes(xend = dateTime, yend = -Inf), linetype = "dashed") +
  theme(axis.text=element_text(size = 14), axis.title=element_text(size = 14),
        axis.title.x=element_blank(),
        axis.text.x=element_blank(),
        axis.ticks.x=element_blank())

plot2 <- df2 %>%
  select(dateTime, value) %>%
  ggplot(aes(dateTime, value)) +
  geom_point() +
  geom_line(color = "red") +
  geom_segment(aes(xend = dateTime, yend = Inf), linetype = "dashed") +
  xlab("dateTime") +
  theme(axis.text=element_text(size = 14), axis.title=element_text(size = 14))

gt <- rbind(ggplotGrob(plot1), ggplotGrob(plot2), size = "last")

# Panel positioning
is_panel <- which(gt$layout$name == "panel")
panel_x <- unique(gt$layout$l[is_panel])
panel_y <- gt$layout$t[is_panel]

# Coordinates and graphical parameters for segments
x_coords <- gt$grobs[[is_panel[1]]]$children[[5]]$x0
gpar <- gt$grobs[[is_panel[1]]]$children[[5]]$gp

linkgrob <- segmentsGrob(x0 = x_coords, y0 = 0, x1 = x_coords, y1 = 1, gp = gpar)
gt <- gtable_add_grob(gt, linkgrob,
                      t = panel_y[1] + 1, l = panel_x, b = panel_y[2] - 1)
grid.newpage()
grid.draw(gt)

Вот результат, но на самом деле есть дополнительная строка, которую я хочу удалить, а также нет точки для последнего значения df1, которую я также хочу показать последней точке:

enter image description here

1 Ответ

1 голос
/ 11 июня 2019

Лаг

Я думаю, что lag, возможно, неправильная функция: 

lag(1:3)
# [1] NA 1 2

Если я вас правильно понимаю, вы хотите сместить ваши данные, и это зависит от ваших реальных данных, но для этого фиктивного примера что-то вроде 

df1 <- df1 %>%
   mutate(dateTime = dateTime + 1)

должен сделать трюк.

Строка

Вам нужно немного адаптировать свои базовые графики: 

plot1 <- df1 %>%
  select(dateTime, value) %>%
  ## create a temp variable to which we can map the line type to
  mutate(lty = ifelse(dateTime == max(dateTime), "none", "dashed")) %>% 
  ggplot(aes(dateTime, value)) +
  geom_point() +
  geom_line(color = "green") +
  ## map the linetype to this variable
  geom_segment(aes(xend = dateTime, yend = -Inf, linetype = lty)) +
  ## use a manual scale to map the variable to dashed and blank linetype
  scale_linetype_manual(values = c(dashed = "dashed", none = "blank"),
                        guide = "none") + 
  ## add xlim to align scales properly in both plots
  xlim(c(1, 5)) +
  theme(axis.text=element_text(size = 14), axis.title=element_text(size = 14),
        axis.title.x=element_blank(),
        axis.text.x=element_blank(),
        axis.ticks.x=element_blank())

plot2 <- df2 %>%
  select(dateTime, value) %>%
  mutate(lty = ifelse(dateTime == min(dateTime), "none", "dashed")) %>%
  ggplot(aes(dateTime, value)) +
  geom_point() +
  geom_line(color = "red") +
  geom_segment(aes(xend = dateTime, yend = Inf, linetype = lty)) +
  scale_linetype_manual(values = c(dashed = "dashed", none = "blank"),
                        guide = "none") + 
  xlab("dateTime") +
  xlim(c(1, 5)) +
  theme(axis.text=element_text(size = 14), axis.title=element_text(size = 14))

Это дает вам этот сюжет:

Linechart

...