我有一个向量
x = c(1820.0, 2235.0, 2534.0, 2580.0, 2322.0, 2317.0, 2331.0, 2345.0,
2305.0, 2265.0, 2277.0, 2289.0, 2338.0, 2387.0, 2152.0, 2256.0,
2360.0, 2590.0, 2529.0, 2468.0, 2776.0, 2909.0, 3017.0, 3081.0,
3118.5, 3156.0, 3338.0, 3211.5)
Run Code Online (Sandbox Code Playgroud)
我想计算除边缘以外的每个元素的左右邻居的平均值。例如,结果应如下所示: mean(1820,2534), mean(2235,2580), mean(2534,2322) ...
我可以使用循环来做到这一点,但这很慢。我需要向量化解决方案。
我的代码使用for循环:
neighbour_m = function(x) {
newx = c(x[length(x)], x, x[1])
for (i in 2:(length(newx) - 1)){
m = mean(c(newx[i-1], newx[i+1]))
}
}
Run Code Online (Sandbox Code Playgroud)
Cle*_*ang 20
在基数R中,您可以使用filter:
stats::filter(x, c(1/2, 0, 1/2), sides = 2)
Run Code Online (Sandbox Code Playgroud)
然后NA使用删除na.omit。
Mau*_*ers 11
使用rowMeans和的另一个基本R选项cbind
rowMeans(cbind(x[1:(length(x) - 2)], x[3:(length(x))]))
# [1] 2177.00 2407.50 2428.00 2448.50 2326.50 2331.00 2318.00 2305.00 2291.00
#[10] 2277.00 2307.50 2338.00 2245.00 2321.50 2256.00 2423.00 2444.50 2529.00
#[19] 2652.50 2688.50 2896.50 2995.00 3067.75 3118.50 3228.25 3183.75
Run Code Online (Sandbox Code Playgroud)
使用lag/ lead来自dplyr:
library("dplyr")
na.omit(rowMeans(data.frame(lag(x, 1), lead(x, 1))))
# [1] 2177 2408 2428 2448 2326 2331 2318 2305 2291 2277 2308 2338 2245 2322 2256
# [16] 2423 2444 2529 2652 2688 2896 2995 3068 3118 3228 3184
# attr(,"na.action")
# [1] 1 28
# attr(,"class")
# [1] "omit"
Run Code Online (Sandbox Code Playgroud)
对此应该有一些更简单的解决方案,但这是使用的一种方法zoo::rollapply。我们为向量的长度,x滚动2个点的子集创建一个奇数和偶数索引序列,并取mean它们。
a1 <- zoo::rollapply(seq(2, length(x), by = 2), 2, function(i) mean(x[i]))
a2 <- zoo::rollapply(seq(1, length(x), by = 2), 2, function(i) mean(x[i]))
c(rbind(a1, a2))
#[1] 2407.50 2177.00 2448.50 2428.00 2331.00 2326.50 2305.00 2318.00 2277.00
# 2291.00 2338.00 2307.50 2321.50 2245.00 2423.00 2256.00 2529.00 2444.50
# 2688.50 2652.50 2995.00 2896.50 3118.50 3067.75 3183.75 3228.25
Run Code Online (Sandbox Code Playgroud)
使用head,tail,然后使用rowMeans:
rowMeans(cbind(head(x, -2), tail(x, -2)))
# [1] 2177.00 2407.50 2428.00 2448.50 2326.50 2331.00 2318.00 2305.00
# [9] 2291.00 2277.00 2307.50 2338.00 2245.00 2321.50 2256.00 2423.00
# [17] 2444.50 2529.00 2652.50 2688.50 2896.50 2995.00 3067.75 3118.50
# [25] 3228.25 3183.75
Run Code Online (Sandbox Code Playgroud)
类似地:
colMeans(rbind(head(x, -2), tail(x, -2)))
Run Code Online (Sandbox Code Playgroud)
1)rollapply表示将指示的偏移量(-1 =上一个值,+ 1 =下一个值)传递给函数mean,并将其作为的滚动应用程序运行mean。这确实需要一个程序包,但是另一方面,它很简洁并且不需要任何索引操作。它还允许灵活地处理边缘,因为如果我们想返回与输入长度相同的向量,则可以添加参数fill = NA或partial = TRUE填充NA值,或在边缘进行部分计算。
library(zoo)
rollapply(x, list(c(-1, 1)), mean)
Run Code Online (Sandbox Code Playgroud)
给予:
[1] 2177.00 2407.50 2428.00 2448.50 2326.50 2331.00 2318.00 2305.00 2291.00
[10] 2277.00 2307.50 2338.00 2245.00 2321.50 2256.00 2423.00 2444.50 2529.00
[19] 2652.50 2688.50 2896.50 2995.00 3067.75 3118.50 3228.25 3183.75
Run Code Online (Sandbox Code Playgroud)
2)rollsum 另一种方法是使用rollsum,然后减去当前值并除以2。na.omit如果希望输出的长度x与NA的长度相同,则将其删除。
library(zoo)
na.omit(rollsum(x / 2, 3, fill = NA) - x / 2)
Run Code Online (Sandbox Code Playgroud)
给予:
[1] 2177.00 2407.50 2428.00 2448.50 2326.50 2331.00 2318.00 2305.00 2291.00
[10] 2277.00 2307.50 2338.00 2245.00 2321.50 2256.00 2423.00 2444.50 2529.00
[19] 2652.50 2688.50 2896.50 2995.00 3067.75 3118.50 3228.25 3183.75
attr(,"na.action")
[1] 1 28
attr(,"class")
[1] "omit"
Run Code Online (Sandbox Code Playgroud)
3)矩阵运算符 此运算是线性的,因此可以用矩阵表示。特别地,我们可以乘以x一个矩阵,该矩阵在上对角线和对角线下为0.5,在其他位置为零。
d <- diag(length(x))
y <- ((abs(row(d) - col(d)) == 1) / 2) %*% x
Run Code Online (Sandbox Code Playgroud)
这样可以在端点进行部分评估,因此,如果您不希望这样做,则可以将其淘汰y[c(1, length(y))] <- NA或丢弃端点y <- y[-c(1, length(y))]。