按日期加权移动平均数 R

Question

下面是一个脚本，用于获取个人的统计数据，并通过过去6天的滚动平均值。 我希望离今天最近的日期比以后的日期更具影响力。

如果可能的话：

- 最接近的2个事件按日期将具有50％的权重。 - 第2个最接近的日期将具有30％的权重。 - 最远的将具有20％的权重。

以下是创建滚动平均值的两种方法：one_df和two_df。我在实际脚本中使用第一种方法，但是我添加了第二种方法，以防写入权重函数更容易。

library(dplyr)
library(lubridate)

# Create DataFrame


df<- data.frame(name=c('CAREY.FAKE','CAREY.FAKE','CAREY.FAKE','CAREY.FAKE','CAREY.FAKE','CAREY.FAKE','CAREY.FAKE',
                       'JOHN.SMITH','JOHN.SMITH','JOHN.SMITH','JOHN.SMITH','JOHN.SMITH','JOHN.SMITH','JOHN.SMITH',
                       'JEFF.JOHNSON','JEFF.JOHNSON','JEFF.JOHNSON','JEFF.JOHNSON','JEFF.JOHNSON','JEFF.JOHNSON','JEFF.JOHNSON',
                       'SARA.JOHNSON','SARA.JOHNSON','SARA.JOHNSON','SARA.JOHNSON','SARA.JOHNSON','SARA.JOHNSON','SARA.JOHNSON'
),
GA=c(3,2,1,1,2,3,20,3,2,1,1,2,3,20,3,2,1,1,2,3,20,3,2,1,1,2,3,20),
SV=c(3,2,1,1,2,3,20,3,2,1,1,2,3,20,3,2,1,1,2,3,20,3,2,1,1,2,3,20),
GF=c(3,2,1,1,2,3,20,3,2,1,1,2,3,20,3,2,1,1,2,3,20,3,2,1,1,2,3,20),
SA=c(3,2,1,1,2,3,20,3,2,1,1,2,3,20,3,2,1,1,2,3,20,3,2,1,1,2,3,20),
date=c("10/20/2016","10/19/2016","10/18/2016","10/17/2016","10/16/2016","10/15/2016","10/14/2016",
       "10/20/2016","10/19/2016","10/18/2016","10/17/2016","10/16/2016","10/15/2016","10/14/2016",
       "10/20/2016","10/19/2016","10/18/2016","10/17/2016","10/16/2016","10/15/2016","10/14/2016",
       "10/20/2016","10/19/2016","10/18/2016","10/17/2016","10/16/2016","10/15/2016","10/14/2016"
),
stringsAsFactors = FALSE)

one_df <- df %>%
  group_by(name) %>%
  arrange(name, mdy(date)) %>% 
  summarise_at(2:5, funs(mean(tail(., 6))))

two_df <- df %>% 
  group_by(name) %>%
  top_n(mdy(date), n = 6) %>%
  summarise_at(2:5, mean)

DF:

    name        GA  SV  GF  SA  date
CAREY.FAKE      3   3   3   3   10/20/2016
CAREY.FAKE      2   2   2   2   10/19/2016
CAREY.FAKE      1   1   1   1   10/18/2016
CAREY.FAKE      1   1   1   1   10/17/2016
CAREY.FAKE      2   2   2   2   10/16/2016
CAREY.FAKE      3   3   3   3   10/15/2016
CAREY.FAKE      20  20  20  20  10/14/2016
JOHN.SMITH      3   3   3   3   10/20/2016
JOHN.SMITH      2   2   2   2   10/19/2016
JOHN.SMITH      1   1   1   1   10/18/2016
JOHN.SMITH      1   1   1   1   10/17/2016
JOHN.SMITH      2   2   2   2   10/16/2016
JOHN.SMITH      3   3   3   3   10/15/2016
JOHN.SMITH      20  20  20  20  10/14/2016
JEFF.JOHNSON    3   3   3   3   10/20/2016
JEFF.JOHNSON    2   2   2   2   10/19/2016
JEFF.JOHNSON    1   1   1   1   10/18/2016
JEFF.JOHNSON    1   1   1   1   10/17/2016
JEFF.JOHNSON    2   2   2   2   10/16/2016
JEFF.JOHNSON    3   3   3   3   10/15/2016
JEFF.JOHNSON    20  20  20  20  10/14/2016
SARA.JOHNSON    3   3   3   3   10/20/2016
SARA.JOHNSON    2   2   2   2   10/19/2016
SARA.JOHNSON    1   1   1   1   10/18/2016
SARA.JOHNSON    1   1   1   1   10/17/2016
SARA.JOHNSON    2   2   2   2   10/16/2016
SARA.JOHNSON    3   3   3   3   10/15/2016
SARA.JOHNSON    20  20  20  20  10/14/2016

结果：

name            GA  SV  GF  SA
CAREY.FAKE      2   2   2   2
JEFF.JOHNSON    2   2   2   2
JOHN.SMITH      2   2   2   2
SARA.JOHNSON    2   2   2   2

预期结果：

name             GA   SV    GF   SA
CAREY.FAKE      2.05 2.05  2.05 2.05
JEFF.JOHNSON    2.05 2.05  2.05 2.05
JOHN.SMITH      2.05 2.05  2.05 2.05
SARA.JOHNSON    2.05 2.05  2.05 2.05

- Michael T Johnson

---

你的预期结果是0.6833吗？权重*值的平均值，mean(c(.5, .5, .3, .3, .2, .2) * c(3, 2, 1, 1, 2, 3))。或者你是指加权移动平均WMA吗？如果权重为c(.5, .5, .3, .3, .2, .2)，那么结果将是2.05。 - phiver

@phiver 是的，它们将是0.5、0.5、0.3、0.3、0.2、0.2。 - Michael T Johnson

权重不是问题，预期结果才是。它是0.6833还是2.05或其他值？滚动平均意味着从第6个值开始的值。您可能需要创建更好的预期输出。 - phiver

这种情况下预期结果为2.05。 - Michael T Johnson

Answer 1

我认为困惑是因为您实际上并不需要移动平均，而是简单加权平均：

weights <- c(.5,.5,.3,.3,.2,.2)
df %>% 
  group_by(name) %>%
  arrange(desc(date)) %>% # sort dates ...
  slice(1:6) %>%          # ... in order to keep only 6 most recent
  summarise_at(vars(-date,-name),
               ~sum(.*weights)/sum(weights)) # apply weighted average
# # A tibble: 4 x 5
#   name            GA    SV    GF    SA
#   <chr>        <dbl> <dbl> <dbl> <dbl>
# 1 CAREY.FAKE    2.05  2.05  2.05  2.05
# 2 JEFF.JOHNSON  2.05  2.05  2.05  2.05
# 3 JOHN.SMITH    2.05  2.05  2.05  2.05
# 4 SARA.JOHNSON  2.05  2.05  2.05  2.05

- moodymudskipper

Answer 2

使用TTR包中的加权移动平均函数WMA可以得到你的结果。 权重应用于选择的期间长度（n = 6）的记录。 权重应与期间长度相同。

library(dplyr)
library(lubridate)
library(purrr)

df %>% 
  group_by(name) %>%
  arrange(name, mdy(date)) %>% 
  mutate_at(2:5, TTR::WMA, n = 6, wts = c(.2, .2, .3, .3, .5, .5))

# A tibble: 28 x 6
# Groups:   name [4]
   name            GA    SV    GF    SA date      
   <chr>        <dbl> <dbl> <dbl> <dbl> <chr>     
 1 CAREY.FAKE   NA    NA    NA    NA    10/14/2016
 2 CAREY.FAKE   NA    NA    NA    NA    10/15/2016
 3 CAREY.FAKE   NA    NA    NA    NA    10/16/2016
 4 CAREY.FAKE   NA    NA    NA    NA    10/17/2016
 5 CAREY.FAKE   NA    NA    NA    NA    10/18/2016
 6 CAREY.FAKE    3.50  3.50  3.50  3.50 10/19/2016
 7 CAREY.FAKE    2.05  2.05  2.05  2.05 10/20/2016
 8 JEFF.JOHNSON NA    NA    NA    NA    10/14/2016
 9 JEFF.JOHNSON NA    NA    NA    NA    10/15/2016
10 JEFF.JOHNSON NA    NA    NA    NA    10/16/2016
# ... with 18 more rows

或者过滤掉 NA 后：

df %>% 
  group_by(name) %>%
  arrange(name, mdy(date)) %>% 
  mutate_at(2:5, TTR::WMA, n = 6, wts = c(.2, .2, .3, .3, .5, .5)) %>% 
  filter(!is.na(GA))

# A tibble: 8 x 6
# Groups:   name [4]
  name            GA    SV    GF    SA date      
  <chr>        <dbl> <dbl> <dbl> <dbl> <chr>     
1 CAREY.FAKE    3.50  3.50  3.50  3.50 10/19/2016
2 CAREY.FAKE    2.05  2.05  2.05  2.05 10/20/2016
3 JEFF.JOHNSON  3.50  3.50  3.50  3.50 10/19/2016
4 JEFF.JOHNSON  2.05  2.05  2.05  2.05 10/20/2016
5 JOHN.SMITH    3.50  3.50  3.50  3.50 10/19/2016
6 JOHN.SMITH    2.05  2.05  2.05  2.05 10/20/2016
7 SARA.JOHNSON  3.50  3.50  3.50  3.50 10/19/2016
8 SARA.JOHNSON  2.05  2.05  2.05  2.05 10/20/2016

编辑：

如果时间窗口中没有足够的值，我们可以创建一个函数，并将其包裹在 purrr 的 possible 函数中，在函数失败时返回 NA。在下面的示例中，我从 "CAREY.FAKE" 中删除了 2 条记录以展示结果。

my_func <- function(x){
  TTR::WMA(x, n = 6, wts = c(.2, .2, .3, .3, .5, .5))
}

df %>% 
  group_by(name) %>%
  arrange(name, mdy(date)) %>% 
  mutate_at(2:5, possibly(my_func, otherwise = NA_real_))

# A tibble: 26 x 6
# Groups:   name [4]
   name            GA    SV    GF    SA date      
   <chr>        <dbl> <dbl> <dbl> <dbl> <chr>     
 1 CAREY.FAKE      NA    NA    NA    NA 10/14/2016
 2 CAREY.FAKE      NA    NA    NA    NA 10/15/2016
 3 CAREY.FAKE      NA    NA    NA    NA 10/16/2016
 4 CAREY.FAKE      NA    NA    NA    NA 10/17/2016
 5 CAREY.FAKE      NA    NA    NA    NA 10/18/2016
 6 JEFF.JOHNSON    NA    NA    NA    NA 10/14/2016
 7 JEFF.JOHNSON    NA    NA    NA    NA 10/15/2016
 8 JEFF.JOHNSON    NA    NA    NA    NA 10/16/2016
 9 JEFF.JOHNSON    NA    NA    NA    NA 10/17/2016
10 JEFF.JOHNSON    NA    NA    NA    NA 10/18/2016
# ... with 16 more rows

- phiver

---

如果没有足够的条目满足一个人达到6的要求怎么办？为此我应该留下少于6个。我收到了“评估错误：n = 6超出有效范围：[1,1]”的提示。 - Michael T Johnson

我很感激您花费的时间。但是它并没有回答我想要的结果。我的结果df包含了过去n天中每个人的平均值，我想得到相同的结果，只是加上一个权重。 - Michael T Johnson

获得您问题中所需的结果只是过滤掉Na值/或选择正确的行的问题。但更重要的是，如何处理边缘情况？如果每个人没有至少6个值，您需要做些什么。这就是编辑所示的，没有应用任何过滤。那么，如果记录少于6条，期望的结果是什么？如果记录多于6条（比如8条），期望的结果又是什么？ - phiver

在上面的例子中，确切地说有6个，我们恰好使用了六个。在示例中的组别中，我实际上使用了过去事件中的25个，用于整个数据集，其中一些人可能参与80多次，而其他人可能只参与一两次。它会选取距离当前日期最近的日期，并在25场比赛范围内进行平均值计算。现在我想对前n场比赛应用权重，直到某个点。如果数据集中有参与比赛较少的人，只需使用他们参与比赛的权重。新的df包含人员及其统计数据。 - Michael T Johnson

Answer 3

如果您运行代码的一部分，您也可以在这里看到权重。本质上，它与上面的答案相同。

df <- df %>% mutate(distance_to_today = today() - as.Date(date, tryFormats = c("%m/%d/%Y")) )  %>% 
arrange(name, distance_to_today) %>% 
group_by(name) %>%  mutate(rank=rank(distance_to_today)) %>% 
mutate(weight=ifelse(rank<=2,0.5,ifelse(rank<=4,0.3,ifelse(rank<=6,0.2,0)))) %>% 
group_by(name) %>% summarise(GA=sum(GA*weight)/sum(weight), 
SV=sum(SV*weight)/sum(weight), GF=sum(GF*weight)/sum(weight), 
SA=sum(SA*weight)/sum(weight))

- swaps1

Answer 4

看起来有一个简单的解决方案，只需要扩展您的初始代码：

w <- rev(c(.5,.5,.3,.3,.2,.2))

# one_df
df %>%
  group_by(name) %>%
  arrange(name, mdy(date)) %>% 
  summarise_at(2:5, funs(weighted.mean(tail(., 6),w)))

## A tibble: 4 x 5
#  name            GA    SV    GF    SA
#  <chr>        <dbl> <dbl> <dbl> <dbl>
#1 CAREY.FAKE    2.05  2.05  2.05  2.05
#2 JEFF.JOHNSON  2.05  2.05  2.05  2.05
#3 JOHN.SMITH    2.05  2.05  2.05  2.05
#4 SARA.JOHNSON  2.05  2.05  2.05  2.05

#two_df
df %>% 
  group_by(name) %>%
  top_n(mdy(date), n = 6) %>%
  summarise_at(2:5,function(x) weighted.mean(x,w))
## A tibble: 4 x 5
#  name            GA    SV    GF    SA
#  <chr>        <dbl> <dbl> <dbl> <dbl>
#1 CAREY.FAKE    2.05  2.05  2.05  2.05
#2 JEFF.JOHNSON  2.05  2.05  2.05  2.05
#3 JOHN.SMITH    2.05  2.05  2.05  2.05
#4 SARA.JOHNSON  2.05  2.05  2.05  2.05

- Nicolas2