r - 使用 ggplot : geom_area ends/starts at different positions when sign changes 显示 SPEI

Question

这是一些数据

structure(list(Period = structure(c(2017.83333333333, 2017.91666666667, 
2018, 2018.08333333333, 2018.16666666667, 2018.25, 2018.33333333333, 
2018.41666666667, 2018.5, 2018.58333333333, 2018.66666666667, 
2018.75, 2018.83333333333, 2018.91666666667, 2019, 2019.08333333333, 
2019.16666666667, 2019.25, 2019.33333333333, 2019.41666666667, 
2019.5), class = "yearmon"), neg = c(0, 0, 0, 0, 0, 0, 0, 0, 
-0.782066446199374, -1.33087717414387, -1.55401649141939, -1.9056578851487, 
-2.19869230289699, -1.99579537718088, -2.03857957860623, -2.14184701726747, 
-2.27461866979037, -2.39022691659445, -2.3732334198156, -1.83686080707261, 
-1.86553025598681), pos = c(0.550567625206492, 0.699954781241267, 
0.775518140437689, 0.647367030217637, 0.84562688020279, 0.923814518387379, 
0.686796306801202, 0.131849327496122, 0, 0, 0, 0, 0, 0, 0, 0, 
0, 0, 0, 0, 0)), row.names = 960:980, class = "data.frame")

我想用 ggplot 绘制 SPEI 值，正如我在这里学到的那样: How to format the x-axis of the hard coded plotting function of SPEI package in R?

library(ggplot2)
ggplot(test) + 
  geom_area(aes(x = Period, y = pos), fill = "blue", col = "black") +
  geom_area(aes(x = Period, y = neg), fill = "red",  col = "black") +
  scale_y_continuous(limits = c(-2.25, 2.25), 
                     breaks = -2:2) +
  ylab("SPEI") + xlab("") +
  theme_bw() 

结果是这样的:

如您所见，当符号从正变为负时，geom_area 的结束/开始位置不同。有人知道如何解决这个问题吗？我考虑过使用 Date 而不是 yearmon，但遇到了同样的问题。

Answer 1

这是一个 gates and posts 问题:拐点处的每个 geom_area 都在一个柱子上开始和结束，因此重叠。他们应该从柱子之间的门中间开始。

这个解决方案可能有点笨拙，但我认为它应该适用于从积极到消极的多重变化，反之亦然。

  library(ggplot2)
  library(tidyr)
  library(tibble)
  library(dplyr)
  library(lubridate)
  library(imputeTS)

确定数据何时从正变为负或反之

  inflections <- 
    test %>% 
    mutate(inflect = case_when(lag(neg) == 0 & pos == 0 ~ TRUE,
                                  lag(pos) == 0 & neg == 0 ~ TRUE,
                                  TRUE ~ FALSE),
           rowid = row_number() - 0.5) %>%
    filter(inflect) %>% 
    select(-inflect) %>% 
    mutate(Period = NA_Date_,
           pos = 0, 
           neg = 0)

插入一个新行来标记拐点，以允许包含一个中间时间，其中 pos 和 neg 都可以为零。

test1 <- 
  test %>% 
  rowid_to_column() %>%
  bind_rows(inflections) %>% 
  arrange(rowid)

使用 imputeTS 中的函数估算数据从 pos 变为 neg 的时间。

test1$Period <- na_interpolation(as.ts(test1$Period))

情节

    ggplot(test1) + 
      geom_area(aes(x = Period, y = pos), fill = "blue", col = "black") +
      geom_area(aes(x = Period, y = neg), fill = "red",  col = "black") +
      scale_y_continuous(limits = c(-2.25, 2.25), 
                         breaks = -2:2) +
      ylab("SPEI") + xlab("") +
      theme_bw() 

data

```
 test <-   structure(list(Period = structure(c(2017.83333333333, 2017.91666666667, 
    2018, 2018.08333333333, 2018.16666666667, 2018.25, 2018.33333333333, 
    2018.41666666667, 2018.5, 2018.58333333333, 2018.66666666667, 
    2018.75, 2018.83333333333, 2018.91666666667, 2019, 2019.08333333333, 
    2019.16666666667, 2019.25, 2019.33333333333, 2019.41666666667, 
    2019.5), class = "yearmon"), neg = c(0, 0, 0, 0, 0, 0, 0, 0, 
    -0.782066446199374, -1.33087717414387, -1.55401649141939, -1.9056578851487, 
    -2.19869230289699, -1.99579537718088, -2.03857957860623, -2.14184701726747, 
    -2.27461866979037, -2.39022691659445, -2.3732334198156, -1.83686080707261, 
    -1.86553025598681), pos = c(0.550567625206492, 0.699954781241267, 
    0.775518140437689, 0.647367030217637, 0.84562688020279, 0.923814518387379, 
    0.686796306801202, 0.131849327496122, 0, 0, 0, 0, 0, 0, 0, 0, 
    0, 0, 0, 0, 0)), row.names = 960:980, class = "data.frame")
```

<sup>Created on 2020-05-22 by the [reprex package](https://reprex.tidyverse.org) (v0.3.0)</sup>