Search code examples
rtidyversextslubridatezoo

Conversion of daily to standard meteorological week in R


I have seen many questions in SO on converting daily data to weekly using xts, zoo or lubridate packages. None of the answers was found appropriate for my problem. I have tried the following code

library(zoo)
library(lubridate)
library(xts)
library(tidyverse)

#Calculation for multistation
set.seed(123)
df <- data.frame("date"= seq(from = as.Date("1970-1-1"), to = as.Date("2000-12-31"), by = "day"),
                 "Station1" = runif(length(seq.Date(as.Date("1970-1-1"), as.Date("2000-12-31"), "days")), 10, 30),
                 "Station2" = runif(length(seq.Date(as.Date("1970-1-1"), as.Date("2000-12-31"), "days")), 11, 29),
                 "Station3" = runif(length(seq.Date(as.Date("1970-1-1"), as.Date("2000-12-31"), "days")), 9, 28))

head(df)

# Aggregate over week
df %>% 
  mutate(Week = week(ymd(date)),
         Year = year(ymd(date))) %>% 
  pivot_longer(-c(Week, date, Year), values_to = "value", names_to = "Station") %>% 
  group_by(Year, Week, Station) %>% 
  summarise(Weekly = mean(value)) %>% 
  arrange(Station) %>% 
  print(n = 55)

From the output you can see that 1970 cotains 53 weeks which I don't want. I want to start the week from the first date of every year and the 52nd week should have 8 days in a nonleap year and in case of leap years 9th and 52nd week should have 8 days so that every year contains 52 weeks only. How to do that in R?


Solution

  • Why not just write a function that gives the meteorological week from the definition you gave? Package lubridate will give you the day of the year with yday, which can act as the index for a vector of the correct week labels. These are straightforward to construct with simple modular math and concatenation.

    You then only need to figure out if you are in a leap year, which again is possible using lubridate::leap_year. Combine these in an ifelse and you have an easy-to-use function:

    met_week <- function(dates)
    {
      normal_year <- c((0:363 %/% 7 + 1), 52)
      leap_year   <- c(normal_year[1:59], 9, normal_year[60:365])
      year_day    <- lubridate::yday(dates)
    
      return(ifelse(lubridate::leap_year(dates), leap_year[year_day], normal_year[year_day]))
    }
    

    and you can do

    df %>% mutate(week = met_week(date))