Summarize weekly data into monthly

summarize_weekly_data_to_monthly.R

# Use case:
# You have a weekly dataset and some variable for that week, i.e.

# week value year
#    1   528 2019
#    2   503 2019
#    3   493 2019
#    4   487 2019
#    5   526 2019
#    6   523 2019
#
# You wish to summarize this data on a monthly basis. This function should
# help you do that.

#' Aggregate weekly data to monthly
#'
#' Splits week into days and aggregates data based on which month the day 
#' comes from.
#'
#' @param xy A data.frame with at least column which you would like to 
#' aggregate and a column with a date that falls within the desired week.
#' @param fml Formula (not fuck my life) where you specify which column you
#' would like to aggregate against which Date column. You can use
#' \code{ISOweek::ISOweek2date()} function to prepare it. See example.
#' @param fun Function to apply to per-week summarization. Defaults to sum.
weeksToMonthYears <- function(xy, fml, fun = sum) {
  f.left <- as.character(fml[[2]])
  f.right <- as.character(fml[[3]])
  
  ym <- ISOweek2date(sprintf("%s-%s", ISOweek(xy[, f.right]), 1:7))
  ym <- strftime(ym, format = "%Y-%m")
  
  variable <- xy[, f.left]
  variable <- rep(variable, 7) * 1/7
  
  out <- aggregate(variable ~ ym, FUN = sum)
  out$variable <- round(out$variable)
  out
}

#' @example
library(ISOweek)

xy <- structure(list(week = 1:8, 
                     value = c(528L, 503L, 493L, 487L, 
                               526L, 523L, 488L, 491L), 
                     year = c(2019L, 2019L, 2019L, 2019L, 
                              2019L, 2019L, 2019L, 2019L)), 
                row.names = c(NA, 8L), class = "data.frame")

# Convert this week-year data into a proper ISO week date.
xy$datum <- ISOweek2date(sprintf("%s-W%02d-%s", xy$year, xy$week, 1))

rs <- sapply(split(xy, f = 1:nrow(xy)), FUN = weeksToMonthYears,
             fml = value ~ datum, simplify = FALSE)

rs <- do.call(rbind, rs)
aggregate(variable ~ ym, FUN = sum, data = rs)

#      ym variable
# 2018-12       75
# 2019-01     2237
# 2019-02     1727