Как добавить несколько вертикальных линий в решетке панели? - PullRequest
Новая
       24

Как добавить несколько вертикальных линий в решетке панели?

0 голосов
/ 14 мая 2019

Рассмотрим этот пример 

library(lubridate)
library(tibble)
library(lattice)

dat <- tibble(mydate = c(ymd('2018-02-01'),
                  ymd('2018-02-02'),
                  ymd('2018-02-03'),
                  ymd('2018-02-04'),
                  ymd('2018-02-05')),
       myx = c(1,2,3,4,5),
       myz = c(2,3,2,3,1))

# A tibble: 5 x 3
  mydate       myx   myz
  <date>     <dbl> <dbl>
1 2018-02-01     1     2
2 2018-02-02     2     3
3 2018-02-03     3     2
4 2018-02-04     4     3
5 2018-02-05     5     1

Я знаю, что могу легко построить два временных ряда, используя xyplot

dat %>% xyplot(myx + myz ~ mydate, outer = TRUE, data = ., type = 'l',
               layout = c(1,2))

enter image description here

Моя проблема в том, что у меня есть еще один tibble, который содержит интересующие даты, и я хотел бы построить вертикальные линии на графике выше для этих дат. 

events <- tibble(mydate = c(ymd('2018-02-03'),
                            ymd('2018-02-05')))

Как я могу сделать это легко?Спасибо!

1 Ответ

1 голос
/ 15 мая 2019

1) функция панели Используйте функцию панели следующим образом: 

xyplot(myx + myz ~ mydate, dat, outer = TRUE, type = "l", layout = 1:2, 
  panel = function(...) {
    panel.xyplot(...)
    panel.abline(v = events$mydate)
  })

2) layer или используйте слой в latticeExtra: 

library(latticeExtra)

xyplot(myx + myz ~ mydate, dat, outer = TRUE, type = "l", layout = 1:2) +
  layer(panel.abline(v = mydate), data = events)

2a) xyplot.zoo Обратите внимание, что это можно немного упростить с помощью zoo: 

library(latticeExtra)
library(zoo)

z <- read.zoo(dat)
xyplot(z) + layer(panel.abline(v = mydate), data = events)

Примечание

Чтобы добавить только первую вертикальную линию к первойпанель и вторая вертикальная линия ко второй панели: 

xyplot(z) +
  layer(panel.abline(v = mydate[1]), data = events, packets = 1) +
  layer(panel.abline(v = mydate[2]), data = events, packets = 2)

или 

vline <- function(i) {
  layer(panel.abline(v = events$mydate[i]), data = list(i = i), packets = i)
}
Reduce("+", init = xyplot(z), lapply(1:2, vline))
...