排序周数作为移动时间段的因素

Ordering Week numbers as factors in moving time periods

我有一个漂亮的小图表可以跟踪一段时间内的数据。数据涵盖过去 12 周滚动,每天收集,按周分组,每周输出。在年份的变化将我的因子(周)发送到 window 并开始在 2018 年第 43 周之前绘制 2019 年第 1 周之前,它一直完美运行。随着订单在新的一年发生变化,我如何自动化因子水平?我可以在第 12 周之前手动调整因子水平,但这似乎是创可贴。 这是我在没有手动干预的情况下尝试实现的输出。

data <-  structure(list(ID = structure(c(1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
    1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 2L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 
    3L, 3L, 4L, 4L, 4L, 4L, 4L, 4L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 
    5L, 5L, 5L, 5L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 
    7L, 7L, 7L, 7L, 7L, 7L, 7L, 7L, 7L, 7L, 7L, 7L, 8L, 8L, 8L, 8L, 
    8L), .Label = c("58", "66", "68", "77", "79", "80", "84", "98"
    ), class = "factor"), Year = c(2019, 2019, 2019, 2018, 2018, 
    2018, 2018, 2018, 2018, 2018, 2018, 2018, 2018, 2018, 2018, 2018, 
    2018, 2019, 2019, 2019, 2018, 2018, 2018, 2018, 2018, 2018, 2018, 
    2018, 2018, 2018, 2018, 2018, 2019, 2019, 2019, 2018, 2018, 2018, 
    2018, 2018, 2018, 2018, 2018, 2018, 2019, 2019, 2019, 2018, 2018, 
    2018, 2018, 2018, 2018, 2018, 2018, 2018, 2019, 2019, 2019, 2018, 
    2018, 2018, 2018, 2018, 2018, 2018, 2018, 2018, 2018, 2018, 2018, 
    2018, 2018), Week = c(1L, 2L, 3L, 43L, 44L, 45L, 46L, 47L, 48L, 
    49L, 50L, 51L, 43L, 44L, 45L, 46L, 47L, 1L, 2L, 3L, 46L, 47L, 
    48L, 49L, 50L, 51L, 44L, 45L, 46L, 47L, 48L, 49L, 1L, 2L, 3L, 
    43L, 44L, 45L, 46L, 47L, 48L, 49L, 50L, 51L, 1L, 2L, 3L, 43L, 
    44L, 45L, 46L, 47L, 48L, 49L, 50L, 51L, 1L, 2L, 3L, 43L, 44L, 
    45L, 46L, 47L, 48L, 49L, 50L, 51L, 43L, 44L, 45L, 46L, 47L), 
        Output = c(49.9, 67.42, 31.27, 65.8925, 79.2925, 103.47, 
        120.1125, 122.645, 109.3925, 91.3125, 81.06, 78.38, 119.13, 
        93.71, 149.74, 122.8775, 117.1075, 32.81, 29.49, 16.71, 42.8725, 
        60.6425, 71.2, 86.155, 78.6225, 81.605, 73.51, 84.42, 105.4, 
        74.515, 57.825, 42.8475, 11.26, 44.34, 22.83, 41.695, 75.77, 
        80.785, 118.175, 131.2875, 124.2375, 124.905, 85.7275, 61.7525, 
        188.23, 108.42, 42.42, 111.41, 79.8825, 70.4075, 72.695, 
        61.235, 58.7825, 47.9275, 46.5275, 48.1775, 11.09, 10.13, 
        0, 21.3375, 30.1275, 32.97, 53.51, 51.09, 40.385, 35.9025, 
        23.44, 21.1125, 111.94, 102.76, 105.71, 112.36, 115.7875)), class = "data.frame", row.names = c(NA, 
    -73L))

 ggplot(data, 
       aes(factor(Week,
                  levels = c(43, 44, 45, 46, 47, 48, 49, 50, 51, 1, 2, 3)),
           Output)) +
geom_line(size = 1.5, 
          aes(colour = ID,
              group = ID)) +
geom_point(aes(y = Output,
               colour = ID),
           size = 4,
           shape = 21,
           fill = "black",
           stroke = 2) + 
  labs(x = "Week Number",
       y = "output") +
  scale_y_continuous(breaks = pretty_breaks(n = 20),
                     limits = c(0, NA))

根据我的评论,我将 week/year 的组合更改为日期,创建绘图,然后将 x 轴格式化为一周:

library(tidyverse)
library(lubridate)

data %>% 
  mutate(date = dmy(paste0("0101", Year)) + days(7*(Week)),
         date = floor_date(date, "weeks", week_start = 1)) %>%   # spoof week/year into date
  ggplot(aes(date, Output)) +
  geom_line(size = 1.5, 
            aes(colour = ID,
                group = ID)) +
  geom_point(aes(y = Output,
                 colour = ID),
             size = 4,
             shape = 21,
             fill = "black",
             stroke = 2) + 
  labs(x = "Week Number",
       y = "output") %>% 
  scale_x_date(date_breaks = "weeks", date_labels = "%W")

希望您有原始日期,而不是必须将周数硬塞回日期,因为这有点混乱。

对于基本 R,考虑创建一个日期列,其中涉及格式化年份,然后将相应的周添加到转换后的日期。从那里开始,将 scale_x_date() 格式化为周数:

data$Date <- with(data, as.Date(paste0(Year, "-01-01"), format="%Y-%m-%d", origin="1970-01-01") +
                               as.difftime(Week, unit="weeks")
             )

head(data)
#   ID Year Week   Output       Date
# 1 58 2019    1  49.9000 2019-01-08
# 2 58 2019    2  67.4200 2019-01-15
# 3 58 2019    3  31.2700 2019-01-22
# 4 58 2018   43  65.8925 2018-10-29
# 5 58 2018   44  79.2925 2018-11-05
# 6 58 2018   45 103.4700 2018-11-12

ggplot(data, 
       aes(Date,
           Output)) +
  geom_line(size = 1.5, 
            aes(colour = ID,
                group = ID)) +
  geom_point(aes(y = Output,
                 colour = ID),
             size = 4,
             shape = 21,
             fill = "black",
             stroke = 2) + 
  labs(x = "Week Number",
       y = "output") +
  scale_y_continuous(breaks = pretty_breaks(n = 20),
                     limits = c(0, NA)) +
  scale_x_date(breaks = pretty_breaks(n = 20),
                   labels = date_format("%W"))