如何解决在 R 中使用 NA 在表中滚动加权总和
我正在尝试在一个表中滚动加权总和,并且有一种涉及矩阵乘法的方法,但是当某些数据丢失时它会中断。
所以如果我使用
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
在我希望它是 NA
时给出 0
。我知道有使用某种 apply 方法的解决方案,但我怀疑使用大表可能会更慢。
解决方法
使用 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
,
线性filter
选项:
t(apply(mydata[-1],1,stats::filter,filter=rev(weights),sides=1))
# [,1] [,4] [,5] [,6]
#[1,] NA NA 15200 15700 17100 18200
#[2,] NA NA NA NA 29700 31000
,
我真的很喜欢 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
如果数据包含 NA
,代码的工作原理完全相同:
mydata[2,3] <- NA
out2 <- mydata %>%
gather(year,.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
版权声明:本文内容由互联网用户自发贡献,该文观点与技术仅代表作者本人。本站仅提供信息存储空间服务,不拥有所有权,不承担相关法律责任。如发现本站有涉嫌侵权/违法违规的内容, 请发送邮件至 dio@foxmail.com 举报,一经查实,本站将立刻删除。