/R/output/BSU_plots.R

https://gitlab.com/pjbirrell/real-time-mcmc · R · 50 lines · 49 code · 1 blank · 0 comment · 1 complexity · 9c19c8929142c0e0f15d8e72aa54023b MD5 · raw file

  1. make.plots <- function(projections, ylab = "", data = NULL, y.format = ".3s") {
  2. Eng_projection <- sum.all(projections) %>% add.quantiles(NULL, QUANTILES)
  3. Eng_data <- sum.all.data(data)
  4. plot.height <- 420 + 150
  5. date <- ymd(date.data)
  6. lines <- list(
  7. list(
  8. type = "line",
  9. y0 = 0,
  10. y1 = 1,
  11. yref = "paper",
  12. x0 = ymd(date.data),
  13. x1 = ymd(date.data),
  14. line = list(color = "red"),
  15. hoverinfo = "Today"
  16. ),
  17. list(
  18. type = "line",
  19. y0 = 0,
  20. y1 = 1,
  21. yref = "paper",
  22. x0 = ymd(20200323),
  23. x1 = ymd(20200323),
  24. line = list(color = "blue"),
  25. hoverinfo = "Lockdown"
  26. )
  27. )
  28. create.subplot <- function(projections, data) {
  29. plot <- projections %>%
  30. pivot_wider(names_from = quantile) %>%
  31. plot_ly(x = ~date, width = 800, height = plot.height) %>%
  32. add_ribbons(ymin = ~`0.025`, ymax = ~`0.975`, color = I("lightblue2"), alpha = 0.25) %>%
  33. add_lines(y = ~`0.5`, color = I("black")) %>%
  34. layout(shapes = lines, showlegend = FALSE, xaxis = list(title = "Date"),
  35. hovermode = "x unified")
  36. if (is.null(data)) return(plot)
  37. plot %>%
  38. add_markers(
  39. data = data,
  40. x = ~date,
  41. y = ~True,
  42. color = I("red"),
  43. hovertemplate = "%{x}: %{y:.3s}<extra>Actual report</extra>"
  44. )
  45. }
  46. return(create.subplot(Eng_projection, Eng_data))
  47. }
  48. make.plots(infections) %>% layout(yaxis = list(title = "Number of new infections"))
  49. make.plots(noisy_deaths, data = dth.dat) %>% layout(yaxis = list(title = "Number of deaths"))