Временной ряд графика с пропущенными диапазонами дат R - PullRequest
Новая
       21

Временной ряд графика с пропущенными диапазонами дат R

0 голосов
/ 24 апреля 2018

Наверное, тривиально, но сложно для меня, чтобы все было правильно.

С учетом start и end даты в A, а также duration in months в диапазоне дат: 

A=
structure(list(start..yyyy.mm. = c(197901L, 197901L, 197901L, 
    197901L, 197901L), X.yyyy.mm. = c(197901L, 197904L, 197908L, 
    197902L, 197902L), duration = c(1L, 4L, 8L, 2L, 2L), area..km.2. = structure(c(1L, 
    2L, 4L, 3L, 5L), .Label = c("46952.85", "c(125267.7, 72379.43, 72468.91, 13200.26)", 
    "c(19814.74, 39570.96)", "c(26513.05, 26513.05, 26513.05, 26513.05, 26513.05, 19898.57, 26513.05, 26513.05)", 
    "c(52291.77, 52291.77)"), class = "factor")), .Names = c("start..yyyy.mm.", 
    "X.yyyy.mm.", "duration", "area..km.2."), class = "data.frame", row.names = c(NA, 
    -5L))

Я хотел бы создать нечто похожее на график, показанный ниже (игнорируйте гистограмму). Каждый duration окрашен по-разному. В A первое значение area соответствует first month в диапазоне дат и т. Д.

Даты в A не являются непрерывными, как вы можете видеть. Следовательно, намерение состоит в том, чтобы создать непрерывную ось дат, такую ​​как ts <- seq(as.Date("1910-01-01"), as.Date("2015-12-31"), by="month") и затененные области относительно дат start и end для данного duration.

Диапазоны дат, в которых не должно быть записано ни одного значения NA.

Как я могу реализовать это R, используя любой пакет?

Первая идея, которая пришла в голову, состояла в том, чтобы создать непрерывную дату как: 

library(dplyr)
data_with_missing_times <- full_join(ts,A)

тогда что заговор? аналогичный вопрос здесь , но здесь я намерен заштриховать диапазоны дат. Мои данные поступают из 1910 - 2015 с пропущенными диапазонами дат с некоторыми интервалами.

Спасибо.

sample plot to reproduce

1 Ответ

0 голосов
/ 25 апреля 2018

Я не уверен, что именно вы хотели построить, но здесь есть кое-что, что помогает.Странно, что у вас есть области в виде фактора, а не в виде столбца списка, так как это вызывает separate_rows и filter, а не просто unnest.Главное здесь - добавить дополнительную строку в каждую группу, чтобы длительность 1 имела два значения даты, а затем добавить правильные даты на основе этих группировок.Это позволяет нам отображать перекрывающиеся даты, используя geom_ribbon или geom_area, независимо от вашего выбора.

РЕДАКТИРОВАТЬ: если вы посмотрите на этот подход, то он избегает создания строк для каждого месяца во временных сериях, вместо этоготолько создавая наблюдения, где есть участки для построения.Если вы хотите расширить пределы оси X, вы можете просто позвонить scale_x_date и изменить пределы, но оно должно автоматически масштабироваться до того места, где находятся данные.Также изменил входные данные таким образом, чтобы ни один из них не перекрывался, и изменил график на ленте для соответствия. 

library(tidyverse)
A <- structure(list(start..yyyy.mm. = c(197901L, 197901L, 197901L,197901L, 197901L), X.yyyy.mm. = c(197901L, 197904L, 197908L,197902L, 197902L), duration = c(1L, 4L, 8L, 2L, 2L), area..km.2. = structure(c(1L,2L, 4L, 3L, 5L), .Label = c("46952.85", "c(125267.7, 72379.43, 72468.91, 13200.26)","c(19814.74, 39570.96)", "c(26513.05, 26513.05, 26513.05, 26513.05, 26513.05, 19898.57, 26513.05, 26513.05)","c(52291.77, 52291.77)"), class = "factor")), .Names = c("start..yyyy.mm.","X.yyyy.mm.", "duration", "area..km.2."), class = "data.frame", row.names = c(NA,-5L))

tbl <- A %>%
  mutate(start = seq.Date(as.Date("1979-01-01"), by = "year", length.out = 5)) %>%
  select(start, duration, area = area..km.2.) %>%
  rowid_to_column() %>%
  separate_rows(area) %>%
  filter(!area %in% c("c", ""))

indices <- seq(nrow(tbl)) %>%
  split(group_indices(tbl, rowid)) %>%
  map(~ c(.x, NA)) %>%
  unlist()

tbl <- tbl[indices, ] %>%
  fill(rowid, start, duration, area) %>%
  group_by(rowid) %>%
  mutate(
    date = seq.Date(
      from = first(start),
      by = "month",
      length.out = first(duration) + 1
    ),
    area = as.numeric(area)
  ) %>%
  ungroup()

ggplot(tbl) +
  geom_ribbon(aes(x = date, fill = factor(rowid), ymax = 1, ymin = 0))


ggplot(tbl) +
  geom_area(
    mapping = aes(x = date, y = area, fill = factor(rowid)),
    alpha = 0.3,
    position = "identity"
    ) +
  scale_x_date(limits = c(as.Date("1979-01-01"), Sys.Date()))

Создано в 2018-04-24 пакетом Представление (v0.2.0).

...