Forma vectorizada para calcular la media de los vecinos izquierdo y derecho en un vector

Question

Tengo un vector

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)

Quiero calcular la media de los vecinos izquierdo y derecho de cada elemento, excepto los bordes. Por ejemplo, el resultado debería ser así: mean(1820,2534), mean(2235,2580), mean(2534,2322) ...

Puedo hacer esto usando bucles, pero eso es muy lento. Necesito una solución vectorizada.

Mi código usando un bucle 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]))
}
}

Answer 1

Debería haber una solución más simple para esto, pero aquí hay una forma de usar zoo::rollapply . Creamos una secuencia de índices pares e impares para la longitud del vector, subconjunto x para obtener 2 puntos y tomamos la mean de ellos.

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

Answer 2

En la base R puedes usar filter:

stats::filter(x, c(1/2, 0, 1/2), sides = 2)

Luego elimine NA usando na.omit .

Answer 3

Otra opción base R usando rowMeans y 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

Answer 4

Usando cabeza , cola , luego fila Medios :

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

Similar:

colMeans(rbind(head(x, -2), tail(x, -2)))

Answer 5

Usando el lag / lead de 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"

Answer 6

1) rollapply Esto dice pasar los desplazamientos indicados (-1 = valor anterior, +1 = valor siguiente) a la función, mean , y ejecutarlo como una aplicación rodante de mean . Esto requiere un paquete pero, por otro lado, es conciso y no requiere ninguna manipulación de índice. También permite un manejo flexible de los bordes, ya que si queremos devolver un vector de la misma longitud que la entrada, podemos agregar el argumento fill = NA o partial = TRUE para llenar con valores de NA o realizar cálculos parciales en los bordes.

library(zoo)
rollapply(x, list(c(-1, 1)), mean)

dando:

 [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

2) rollsum Otro enfoque es usar rollsum y luego restar el valor actual y dividir por 2. Suelte na.omit si desea una salida de la misma longitud que x con NA en el extremo.

library(zoo)
na.omit(rollsum(x / 2, 3, fill = NA) - x / 2)

dando:

 [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"

3) Operador de matriz Esta operación es lineal, por lo que puede representarse mediante una matriz. En particular, podemos multiplicar x por una matriz que tiene un 0.5 en las super y sub-diagonales y ceros en otros lugares.

d <- diag(length(x))
y <- ((abs(row(d) - col(d)) == 1) / 2) %*% x

Esto proporciona una evaluación parcial en los puntos finales, por lo que si no desea eso, elimínelos y[c(1, length(y))] <- NA o elimine los puntos finales y <- y[-c(1, length(y))] .