Speed up `autoplot.epi_archive`

[brookslogan]

With daily-time daily-version data and multiple locations, the wait time can be an annoyance, or it can brick some machines (maybe from memory usage expanding quadratically). Here's some progress toward a faster approach, at least if there aren't a bunch of revisions:

tibble(
  current = s05_smoothed_phrru_archive$DT %>%
    as.data.frame() %>%
    as_tibble(),
  preceding =
    s05_smoothed_phrru_archive$DT[
      unique(s05_smoothed_phrru_archive$DT[, key_colnames(s05_smoothed_phrru_archive), with = FALSE])[
      , time_value := epiprocess:::time_minus_n_steps(time_value, 1L,  s05_smoothed_phrru_archive$time_type)
      ],
      on = key_colnames(s05_smoothed_phrru_archive),
      roll = TRUE
    ] %>%
    as.data.frame() %>%
    as_tibble(),
  subsequent =
    copy(s05_smoothed_phrru_archive$DT)[
    , .version := version
    ][
      unique(s05_smoothed_phrru_archive$DT[, key_colnames(s05_smoothed_phrru_archive), with = FALSE])[
      , time_value := epiprocess:::time_plus_n_steps(time_value, 1L,  s05_smoothed_phrru_archive$time_type)
      ],
      on = key_colnames(s05_smoothed_phrru_archive),
      roll = TRUE
    ] %>%
    as.data.frame() %>%
    as_tibble()
) %>%
  filter(current$geo_value == "103") %>%
  mutate(current_lag = current$version - current$time_value) %>%
  # ggplot(aes(colour = current$version)) %>%
  ggplot(aes(colour = current_lag)) %>%
  `+`(geom_segment(aes(x = preceding$time_value, xend = current$time_value,
                       y = preceding$s05_smoothed, yend = current$s05_smoothed),
                   function(tbl) {
                     tbl %>% filter(!is.na(preceding$s05_smoothed))
                   })) %>%
  `+`(geom_segment(aes(x = current$time_value, xend = subsequent$time_value,
                       y = current$s05_smoothed, yend = subsequent$s05_smoothed),
                   function(tbl) {
                     tbl %>% filter(!is.na(subsequent$s05_smoothed), current$version != subsequent$.version)
                   })) %>%
  # `+`(scale_colour_viridis_c(trans = "date")) %>%
  `+`(scale_colour_viridis_c()) %>%
  {}

todo: faceting, isolated points

[brookslogan]

Functionified a bit

epix_plot_versions_color_lags <- function(archive, signal) {
  signal_str <- rlang::ensym(signal)
  tibble(
    current = archive$DT %>%
      as.data.frame() %>%
      as_tibble(),
    preceding =
      archive$DT[
        unique(archive$DT[, key_colnames(archive), with = FALSE])[
        , time_value := epiprocess:::time_minus_n_steps(time_value, 1L,  archive$time_type)
        ],
        on = key_colnames(archive),
        roll = TRUE
      ] %>%
      as.data.frame() %>%
      as_tibble(),
    subsequent =
      copy(archive$DT)[
      , .version := version
      ][
        unique(archive$DT[, key_colnames(archive), with = FALSE])[
        , time_value := epiprocess:::time_plus_n_steps(time_value, 1L,  archive$time_type)
        ],
        on = key_colnames(archive),
        roll = TRUE
      ] %>%
      as.data.frame() %>%
      as_tibble()
  ) %>%
    mutate(current_lag = current$version - current$time_value) %>%
    mutate(current_lag_cat = cut(as.numeric(current_lag), c(-Inf,0,7,14,21,28,28*2,28*3,28*6,28*9,28*12,Inf))) %>%
    mutate(current_tv = paste0(current$time_value," @ ",current$version,", lag ",current_lag)) %>%
    ggplot(aes(
      colour = current_lag_cat,
      label = current_tv, # for ggplotly hover labels & readable x=date hover labels on some segments
      fontface = preceding$time_value # for readable x=date hover labels on other segments
    )) %>%
    `+`(geom_segment(aes(x = preceding$time_value, xend = current$time_value,
                         y = preceding[[signal_str]], yend = current[[signal_str]]),
                     function(tbl) {
                       tbl %>% filter(!is.na(preceding[[signal_str]]))
                     })) %>%
    `+`(geom_segment(aes(x = current$time_value, xend = subsequent$time_value,
                         y = current[[signal_str]], yend = subsequent[[signal_str]]),
                     function(tbl) {
                       tbl %>% filter(!is.na(subsequent[[signal_str]]), current$version != subsequent$.version)
                     })) %>%
    # `+`(scale_colour_viridis_d(end = 0.8)) %>%
    # `+`(scale_colour_brewer(palette = "YlOrRd")) %>%
    `+`(scale_colour_brewer(palette = "Paired")) %>%
    `+`(geom_line(aes(time_value, .data[[signal_str]], linetype = "Inf"),
                  inherit.aes = FALSE,
                  colour = "black",
                  archive %>%
                    epix_as_of(.$versions_end)
                  )) %>%
    `+`(scale_linetype_manual(values = "dotted")) %>% # for ggplotly toggle
    {}
}

[brookslogan]

Above is a history plot connected by version, colored by lag. Current is connected by version, colored by version. Consider also alternative plots connected by lag. Consider also heat map tables with time x lag and/or version x lag as the positional dimensions.