## ----setup2, message = FALSE, warning = FALSE, results = 'hide'---------------
knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>"
)
library(baselinenowcast)
library(ggplot2)
library(dplyr)
library(tidyr)

## -----------------------------------------------------------------------------
nowcast_date <- "2021-08-01"
eval_date <- "2021-10-01"

target_data <- filter(
  germany_covid19_hosp,
  location == "DE", age_group == "00+",
  report_date <= eval_date,
  reference_date <= nowcast_date
)

## -----------------------------------------------------------------------------
latest_data <- target_data |>
  group_by(reference_date) |>
  summarise(final_count = sum(count))

## -----------------------------------------------------------------------------
observed_data <- filter(
  target_data,
  report_date <= nowcast_date
)

head(observed_data)

## -----------------------------------------------------------------------------
initial_reports <- observed_data |>
  group_by(reference_date) |>
  summarise(initial_count = sum(count))

## -----------------------------------------------------------------------------
plot_data <- ggplot() +
  geom_line(
    data = initial_reports,
    aes(x = reference_date, y = initial_count), color = "darkred"
  ) +
  geom_line(
    data = latest_data,
    aes(x = reference_date, y = final_count), color = "black"
  ) +
  theme_bw() +
  xlab("Reference date") +
  ylab("Confirmed admissions") +
  scale_y_continuous(trans = "log10") +
  ggtitle("Comparing initially reported and later observed cases")

## -----------------------------------------------------------------------------
plot_data

## -----------------------------------------------------------------------------
max_delay <- 30

## -----------------------------------------------------------------------------
scale_factor <- 3
prop_delay <- 0.5

## -----------------------------------------------------------------------------
rep_tri_full <- as_reporting_triangle(observed_data)

## -----------------------------------------------------------------------------
rep_tri_full

## -----------------------------------------------------------------------------
summary(rep_tri_full)

## -----------------------------------------------------------------------------
rep_tri <- truncate_to_delay(rep_tri_full, max_delay = max_delay)

## -----------------------------------------------------------------------------
rep_tri

## -----------------------------------------------------------------------------
triangle_df <- as.data.frame(rep_tri) |>
  mutate(time = as.numeric(factor(reference_date)))

plot_triangle <- ggplot(
  triangle_df,
  aes(x = delay, y = time, fill = count)
) +
  geom_tile() +
  scale_fill_gradient(low = "white", high = "blue") +
  labs(title = "Reporting triangle", x = "Delay", y = "Time") +
  theme_bw() +
  scale_y_reverse()

## -----------------------------------------------------------------------------
plot_triangle

## -----------------------------------------------------------------------------
nowcast_draws_df <- baselinenowcast(
  rep_tri,
  scale_factor = scale_factor,
  prop_delay = prop_delay,
  draws = 100
)

## -----------------------------------------------------------------------------
obs_with_nowcast_draws_df <- nowcast_draws_df |>
  left_join(latest_data, by = "reference_date") |>
  left_join(initial_reports, by = "reference_date")
head(obs_with_nowcast_draws_df)

## -----------------------------------------------------------------------------
combined_data <- obs_with_nowcast_draws_df |>
  select(reference_date, initial_count, final_count) |>
  distinct() |>
  pivot_longer(
    cols = c(initial_count, final_count),
    names_to = "type",
    values_to = "count"
  ) |>
  mutate(type = case_when(
    type == "initial_count" ~ "Initial reports",
    type == "final_count" ~ "Final observed data"
  ))

# Plot with draws for nowcast only
plot_prob_nowcast <- ggplot() +
  # Add nowcast draws as thin gray lines
  geom_line(
    data = obs_with_nowcast_draws_df,
    aes(
      x = reference_date, y = pred_count, group = draw,
      color = "Nowcast draw", linewidth = "Nowcast draw"
    )
  ) +
  # Add observed data and final data once
  geom_line(
    data = combined_data,
    aes(
      x = reference_date,
      y = count,
      color = type,
      linewidth = type
    )
  ) +
  theme_bw() +
  scale_color_manual(
    values = c(
      "Nowcast draw" = "gray",
      "Initial reports" = "darkred",
      "Final observed data" = "black"
    ),
    name = ""
  ) +
  scale_linewidth_manual(
    values = c(
      "Nowcast draw" = 0.2,
      "Initial reports" = 1,
      "Final observed data" = 1
    ),
    name = ""
  ) +
  scale_y_continuous(trans = "log10") +
  xlab("Reference date") +
  ylab("Hospital admissions") +
  theme(legend.position = "bottom") +
  ggtitle("Comparison of admissions as of the nowcast date, later observed counts, \n and probabilistic nowcasted counts") # nolint

## -----------------------------------------------------------------------------
plot_prob_nowcast