Created
May 1, 2020 08:09
-
-
Save romunov/1ccf0d577dc6189fa7d86438721f6de1 to your computer and use it in GitHub Desktop.
Summarize weekly data into monthly
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
# 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 |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment