Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
``` r
library(slider)
library(tidyverse)
set.seed(20210715)
sim_data <- crossing(
player = letters[1:7],
year = 2019:2020,
week = 1:17
) %>%
mutate(
row_n = row_number(),
qbr = rnorm(n = max(row_n), mean = 70, sd = 8)
)
my_roll_mean <- function(x){
weighted.mean(x, w = c(.1, 0.25, 0.5, 0.75, 1))
}
plot_data <- sim_data %>%
group_by(player) %>%
mutate(
pure_roll_avg = slide_dbl(qbr, mean, .before = 4L, .complete = TRUE),
weight_roll_avg = slide_dbl(qbr, my_roll_mean, .before = 4L, .complete = TRUE)
) %>%
mutate(grp_row = row_number()) %>%
ungroup() %>%
nest_by(player, .keep = TRUE) %>%
summarize(data = bind_cols(
data,
loess = loess(qbr ~ grp_row, degree = 1, span = 0.2, data = data)$fitted),
.groups = "drop"
) %>%
pluck("data")
plot_data %>%
mutate(loess = if_else(is.na(weight_roll_avg), NA_real_, loess)) %>%
pivot_longer(cols=c(pure_roll_avg, weight_roll_avg, loess), names_to = "type", values_to = "avg") %>%
ggplot(aes(x = grp_row, y = avg, color = type)) +
geom_line() +
facet_wrap(~player)
#> Warning: Removed 12 row(s) containing missing values (geom_path).
```
![](https://i.imgur.com/I8TJzVP.png)
<sup>Created on 2021-10-25 by the [reprex package](https://reprex.tidyverse.org) (v2.0.1)</sup>
@jthomasmock

This comment has been minimized.

Copy link
Owner Author

@jthomasmock jthomasmock commented Oct 25, 2021

ggplot2 output from the above code. It represents an overlay of the simulated data facetted by player, with the output generally showing a similar path for loess a rolling average and a weight rollling average.

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment