Forma vectorizada para calcular la media de los vecinos izquierdo y derecho en un vector
(6)
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
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]))
}
}
En la base R puedes usar filter:
stats::filter(x, c(1/2, 0, 1/2), sides = 2)
Luego elimine
NA
usando
na.omit
.
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
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)))
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"
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))]
.