How to calculate mean values for the next 63 days in R´s dplyr?

Viewed 28

I need to create a function that calculates the average of the next 15 rows if the date is equal to day 02.

How can I do this using R's dplyr mutate? In Excel I have:

In R I tryed:

library(dplyr)

ex_dataset <- read.csv( file = "https://raw.githubusercontent.com/rhozon/datasets/master/example_dataset.csv", header = TRUE, sep = ";") 

glimpse(ex_dataset)

ex_dataset <- ex_dataset %>%
  mutate(
    metric = case_when( 
      date == day(date) == 2 ~ rollapply(residual, 15, mean)
  )
)

How can I fix this ? I tryed slice function but, I didn´t had success.

1 Answers

Using zoo:

library(zoo)
library(dplyr)

ex_dataset <- ex_dataset %>%
  mutate(day = substr(date, 1, 2) %>% as.numeric,
         metric = rollapplyr(data = ex_dataset$residual, 
                             width = 15, 
                             FUN = mean, 
                             align = "left",
                             fill = NA)) %>%
  mutate(metric = case_when(day == 2 ~ metric,
                            TRUE ~ NA_real_))

A verbose but essentially dplyr-specific solution:

library(dplyr)
library(purrr)

# Read data
ex_dataset <-
  read.csv(file = "https://raw.githubusercontent.com/rhozon/datasets/master/example_dataset.csv", header = TRUE, sep = ";")

# Add the day to data, an indicator if day == 2, and a row id
ex_dataset <- ex_dataset %>%
  mutate(
    day = substr(date, 1, 2) %>% as.numeric,
    day2 = case_when(day == 2 ~ 1,
                     TRUE ~ 0),
    row_id = 1:n()
  )

# Get all row indices where day == 2
# then created row indices for upper end of range
# and an identifier for each 16 day window
window_size <- 16
window_day_number <- 2

df <- data.frame(start_row = which(ex_dataset$day == window_day_number)) %>%
  mutate(end_row = start_row + window_size - 1)

# Define a function to take two values
# and create a sequence from them
make_seq <- function(x, y) {
  seq(from = x, to = y, by = 1)
}

# Get sequences and turn into crosswalk for groups and rows
crosswalk <- map2(
  .x = df$start_row,
  .y = df$end_row,
  ~ data.frame(row_id = make_seq(.x, .y)) %>%
    mutate(group = .x)
) %>%
  bind_rows()

# Create vector of NAs then replace with the group ID for rows in the windows
ex_dataset <- ex_dataset %>% left_join(crosswalk, by = "row_id")

# Group by window, calculate mean
avgs <- ex_dataset %>%
  group_by(group) %>%
  summarise(avg = mean(residual))

# Add back to original data, remove values
# for rows other than the 2nd day
ex_dataset <- ex_dataset %>%
  left_join(avgs, by = "group")

ex_dataset[-df$start_row, "avg"] <- NA

Related