在 R 中使用 NA 跨表滚动加权和答案

【问题标题】：Rolling weighted sum across table with NA in R在 R 中使用 NA 跨表滚动加权和
【发布时间】：2021-05-27 22:29:23
【问题描述】：

我正在尝试在表格中获得滚动加权和，并且有一种涉及矩阵乘法的方法，但是当某些数据丢失时它会中断。

所以如果我使用

library(tidyverse)
mydata <- tibble(Country = c("Australia", "Canada"),
                 "1980" = c(1000, 2000),
                 "1981" = c(1100, 2100),
                 "1982" = c(1300, 2300),
                 "1983" = c(1200, 2400),
                 "1984" = c(1400, 2200),
                 "1985" = c(1500, 2500))
weights <- c(3, 4, 6)

n0 <- ncol(mydata) - length(weights)
matweights <- matrix(rep(c(rep(0, n0), weights), n0)[-(1:n0)], ncol=n0) 
tibble(cbind(mydata[, 1], as.matrix(mydata[, -1]) %*%  matweights))

我得到我想要的东西

# A tibble: 2 x 5
  Country     `1`   `2`   `3`   `4`
  <chr>     <dbl> <dbl> <dbl> <dbl>
1 Australia 15200 15700 17100 18200
2 Canada    28200 29900 29700 31000

例如右上角的18200 是3*1200 + 4*1400 + 6*1500

但是，例如，如果缺少其中一个值，比如mydata[2, 3] <- NA，那么我会得到

# A tibble: 2 x 5
  Country     `1`   `2`   `3`   `4`
  <chr>     <dbl> <dbl> <dbl> <dbl>
1 Australia 15200 15700 17100 18200
2 Canada       NA    NA    NA    NA

当我想要时

# A tibble: 2 x 5
  Country     `1`   `2`   `3`   `4`
  <chr>     <dbl> <dbl> <dbl> <dbl>
1 Australia 15200 15700 17100 18200
2 Canada       NA    NA 29700 31000

我的矩阵方法的问题是0 * NA 在我希望它是0 时给出NA。我知道有使用某种 apply 方法的解决方案，但我怀疑使用大表可能会更慢。

【问题讨论】：

这似乎解决了您想要的问题，带有 NA 处理的矩阵乘法：stackoverflow.com/questions/16535084/…
@Baroque 这是一个好主意（将 NA 变为 0，进行乘法，然后将 0 变为 NA）。在我的真实情况下，0 是可能的，虽然不太可能

标签： r missing-data

【解决方案1】：

使用 rollapply 我们有以下矩阵：

library(zoo)
t(rollapply(t(mydata[, -1]), 3, function(x) sum(x * weights)))
##       [,1]  [,2]  [,3]  [,4]
## [1,] 15200 15700 17100 18200
## [2,]    NA    NA 29700 31000

【讨论】：

【解决方案2】：

线性filtering 选项：

t(apply(mydata[-1], 1, stats::filter, filter=rev(weights), sides=1))
#     [,1] [,2]  [,3]  [,4]  [,5]  [,6]
#[1,]   NA   NA 15200 15700 17100 18200
#[2,]   NA   NA    NA    NA 29700 31000

【讨论】：

【解决方案3】：

我真的很喜欢 slider 的滑动函数——它非常灵活，并且有类似 purrr 的语法。在这里，slide_index_dbl() 将让我们滑动一个函数并使用另一个变量作为索引来决定窗口内的观察值。

首先，重塑为长格式和分组，然后是mutate() 内的单个调用。 .before 这里指定要包括多少年； .complete 指定忽略部分窗口。

library(tidyverse)

out1 <- mydata %>% 
    gather(year, value, -Country, convert = TRUE) %>% 
    group_by(Country) %>% 
    mutate(
        value_3y = slider::slide_index_dbl(
            value, .i = year, 
            .f = ~sum(.x * weights), 
            .before = 2, .complete = TRUE
        )
    )

out1
#> # A tibble: 12 x 4
#> # Groups:   Country [2]
#>    Country    year value value_3y
#>    <chr>     <int> <dbl>    <dbl>
#>  1 Australia  1980  1000       NA
#>  2 Canada     1980  2000       NA
#>  3 Australia  1981  1100       NA
#>  4 Canada     1981  2100       NA
#>  5 Australia  1982  1300    15200
#>  6 Canada     1982  2300    28200
#>  7 Australia  1983  1200    15700
#>  8 Canada     1983  2400    29900
#>  9 Australia  1984  1400    17100
#> 10 Canada     1984  2200    29700
#> 11 Australia  1985  1500    18200
#> 12 Canada     1985  2500    31000

重塑宽幅形状：

out1 %>% 
    select(-value) %>%
    drop_na() %>%    # omit to keep partial/empty years
    spread(year, value_3y)
#> # A tibble: 2 x 5
#> # Groups:   Country [2]
#>   Country   `1982` `1983` `1984` `1985`
#>   <chr>      <dbl>  <dbl>  <dbl>  <dbl>
#> 1 Australia  15200  15700  17100  18200
#> 2 Canada     28200  29900  29700  31000

如果数据中包含NAs，代码的工作原理完全相同：

mydata[2, 3] <- NA

out2 <- mydata %>% 
    gather(year, value, -Country, convert = TRUE) %>% 
    group_by(Country) %>% 
    mutate(
        value_3y = slider::slide_index_dbl(
            value, .i = year, 
            .f = ~sum(.x * weights), 
            .before = 2, .complete = TRUE
        )
    )

out2
#> # A tibble: 12 x 4
#> # Groups:   Country [2]
#>    Country    year value value_3y
#>    <chr>     <int> <dbl>    <dbl>
#>  1 Australia  1980  1000       NA
#>  2 Canada     1980  2000       NA
#>  3 Australia  1981  1100       NA
#>  4 Canada     1981    NA       NA
#>  5 Australia  1982  1300    15200
#>  6 Canada     1982  2300       NA
#>  7 Australia  1983  1200    15700
#>  8 Canada     1983  2400       NA
#>  9 Australia  1984  1400    17100
#> 10 Canada     1984  2200    29700
#> 11 Australia  1985  1500    18200
#> 12 Canada     1985  2500    31000

out2 %>% 
    select(-value) %>%
    drop_na() %>% 
    spread(year, value_3y)
#> # A tibble: 2 x 5
#> # Groups:   Country [2]
#>   Country   `1982` `1983` `1984` `1985`
#>   <chr>      <dbl>  <dbl>  <dbl>  <dbl>
#> 1 Australia  15200  15700  17100  18200
#> 2 Canada        NA     NA  29700  31000

【讨论】：