R/r6_weekly.R

In folkehelseinstituttet/dashboards_normomo: Depreciated - to be removed

#' quasipoission
#' @import R6
#' @export weekly
weekly <- R6::R6Class(
  "weekly",
  portable = FALSE,
  cloneable = FALSE,
  list(
    results_x = NULL,
    initialize = function() {
      fd::drop_table("normomo_weekly_data")

      results_x <<- fd::schema$new(
        db_config = fd::config$db_config,
        db_table = glue::glue("normomo_weekly_data"),
        db_field_types = weekly_data_field_types,
        db_load_folder = "/xtmp/",
        keys = weekly_data_keys,
        check_fields_match = TRUE
      )

      results_x$db_connect()
    },
    run_all = function(masterData) {
      fd::msg("normomo weekly starting", slack = T)

      weekly <- fd::tbl("normomo_standard_results") %>%
        dplyr::collect() %>%
        fd::latin1_to_utf8()
      weekly <- weekly[, c("location_code", "age", "yrwk", "nb", "nbc")]
      setnames(weekly, c("nb", "nbc"), c("weekly_nb", "weekly_nbc"))

      max_date <- fhidata::days[yrwk == max(weekly$yrwk)]$sun
      locations <- c("norge", unique(fd::norway_locations()$county_code))

      d <- masterData[, .(nb = .N), keyby = .(ageCat, DoD, location_code)]
      dt <- d[, .(nb = sum(nb)), keyby = .(DoD, location_code)]
      dt[, ageCat := "Total"]
      d <- rbind(d, dt)
      d[, age := ageCat]
      d[, ageCat := NULL]
      dt <- d[, .(nb = sum(nb)), keyby = .(DoD, age)]
      dt[, location_code := "norge"]
      d <- rbind(d, dt)
      d <- d[location_code != "countyNA"]

      skeleton <- expand.grid(
        location_code = unique(d$location_code),
        age = unique(d$age),
        DoD = seq.Date(min(d$DoD), max_date, 1),
        stringsAsFactors = F
      )
      setDT(skeleton)
      skeleton[d, on = c("location_code", "age", "DoD"), nb := nb]
      skeleton[is.na(nb), nb := 0]
      skeleton[, yrwk := fhi::isoyearweek(DoD)]

      d <- skeleton[, .(
        date = max(DoD),
        nb = sum(nb)
      ), keyby = .(
        location_code,
        age,
        yrwk
      )]
      d[, year := fhi::isoyear_n(date)]
      d[, wk := fhi::isoweek_n(date)]

      setorder(d, location_code, age, date)
      results_x$db_upsert_load_data_infile(d)
    }
  )
)

weekly_data_field_types <- c(
  "location_code" = "TEXT",
  "age" = "TEXT",
  "date" = "DATE",
  "year" = "INTEGER",
  "wk" = "INTEGER",
  "yrwk" = "TEXT",
  "nb" = "DOUBLE"
)

weekly_data_keys <- c(
  "location_code",
  "age",
  "date"
)