Lagging 1 year in xts object with weekly frequency

I am trying to lag an xts dataset by 1 year. The data has weekly frequency, and I am currently using lag.xts function like so:

lag.xts(my_data, 52)

The problem is not all years have 52 weeks (some have 53). Is there a way I can take this into account somehow?

Here's an alternative solution that converts to tibble and then back to xts.

Helper to convert xts to tibble.

xts_as_tibble <- function(x, name = "time", value = "value", group = "group"){
  time <- attr(x, "index")
  if ("POSIXt" %in% attr(time, "tclass")){
    if (!is.null(attr(time, "tzone"))){
      time <- lubridate::as_datetime(time,
                                     tz = attr(time, "tzone"))
    } else {
      time <- lubridate::as_datetime(time)
    }
  } else if ("Date" %in% attr(time, "tclass")){
    time <- lubridate::as_date(time)
  } else {
    time <- as.numeric(time)
  }
  ncol <- ncol(x)
  groups <- rep(colnames(x), each = length(time))
  if (is.null(groups)){
    groups <- rep(seq_len(ncol), each = length(time))
  }
  time <- rep(time, times = ncol)
  dplyr::tibble(!!group := groups,
                !!name := time,
                !!value := as.vector(x))
}

Calculation

library(tidyverse)
res <- my_data %>%
  xts_as_tibble() %>%
  pivot_wider(names_from = group, values_from = value) %>%
  mutate(across(-time, ~ if_else(time >= min(time) + years(1), .x, NA)))
my_data_lag <- xts(select(res, -time), order.by = res$time)

I'm assuming you want to find the date which is closest to the specified date, minus a year?

This does the equivalent, but for a dataframe of values:

library(tidyverse)

data <- tibble(x = rnorm(100), 
               dates = seq(as.Date("2015-12-27"), length = 100, by = "weeks"))

find_closest_day <- function(t) {
    ty = t - years(1)
    t52 = abs((t - weeks(52)) - ty)
    t53 = abs((t - weeks(53)) - ty)
    if (t52 < t53) {
        return(t - weeks(52))
    } else {
        return(t - weeks(53))
    }
}
find_closest_day<- Vectorize(find_closest_day)

data %>% 
  mutate(lagged_monday = as.Date(find_closest_day(dates))) %>%
  left_join(data, by = c("lagged_monday" = "dates"))

       x.x dates      lagged_monday   x.y
     <dbl> <date>     <date>        <dbl>
 1 -0.0768 2015-12-27 2014-12-28       NA
 2 -0.711  2016-01-03 2015-01-04       NA
 3 -1.94   2016-01-10 2015-01-11       NA
 4  0.584  2016-01-17 2015-01-18       NA
 5 -0.266  2016-01-24 2015-01-25       NA
 6 -1.04   2016-01-31 2015-02-01       NA
 7 -0.954  2016-02-07 2015-02-08       NA
 8 -0.809  2016-02-14 2015-02-15       NA
 9  0.458  2016-02-21 2015-02-22       NA
10  0.367  2016-02-28 2015-03-01       NA
# ℹ 90 more rows