detrending_fun: Data detrending

In EMDominic/SThelperfunctions: Helper Functions For Spatiotemporal Analysis

Description

Detrending aggregated time series data using natural cubic splines. This function takes output from the mortality_rate_fun().

Usage

detrending_fun(df,
               time.aggregate = c("WOD", "MOD"),
               dof = 4,
               scale.aggregate = c("Province", "Countrywide"))

Arguments

df	Aggregated mortality rates
time.aggregate	Whether to aggregate weekly ("WOD") or monthly ("MOD")
dof	Degrees of freedom for the spline
by_province	Whether to aggregate by province or country level

Examples

## The function is currently defined as

detrending_fun <- function(df,
                           time.aggregate = c("WOD", "MOD"),
                           dof = 4,
                           scale.aggregate = c("Province", "Countrywide")) {

  time.aggregate = rlang::arg_match(time.aggregate)
  time.cycle <- if_else(time.aggregate == "WOD", 52.17, 12)
  quo.time.aggregate = rlang::sym(time.aggregate)

  scale.aggregate = rlang::arg_match(scale.aggregate)

  det.data <- if (scale.aggregate == "Province")
  {group_by(df, DeathProv) %>%
      mutate(tt = seq(from = 1997, to = 2016.999, by = 1/time.cycle),
             t = row_number()) %>%
      ungroup() %>%
      gather(key = "death",
             value = "rates",
             All_deaths_rate:RSV_deaths_rate,
             na.rm = T) %>%
      group_by(DeathProv, death) %>%
      nest()
  }
  else {mutate(df,
                  tt = seq(from = 1997.000, to = 2016.999, by = 1/time.cycle),
                  t = row_number()) %>%
      gather(key = "death",
             value = "rates",
             All_deaths_rate:RSV_deaths_rate,
             na.rm = T) %>%
      group_by(death) %>%
      nest()}

  det.data %>%
    mutate(fit = map(data, ~ lm(rates ~ ns(t,dof),data = .)),
           trend = map(fit, predict)) %>%
    unnest(c(data,trend)) %>%
    select(-fit) %>%
    mutate(detrended = rates - trend,
           mean_death_rate = mean(rates),
           detrended_plus_mean = detrended + mean_death_rate) %>%
    ungroup()
}

EMDominic/SThelperfunctions documentation built on Aug. 4, 2020, 12:02 a.m.