una - sustituir na por 0 en r

Forma rápida de crear una matriz binaria con un número conocido de 1 cada fila en R

Question

Tengo un vector que proporciona cuántos "1" tiene cada fila de una matriz. Ahora tengo que crear esta matriz fuera del vector.

Por ejemplo, supongamos que quiero crear una matriz de 4 x 9 con el siguiente vector v <- c(2,6,3,9) . El resultado debería verse como

 [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9]
[1,] 1 1 0 0 0 0 0 0 0
[2,] 1 1 1 1 1 1 0 0 0
[3,] 1 1 1 0 0 0 0 0 0
[4,] 1 1 1 1 1 1 1 1 1

He hecho esto con un bucle for pero mi solución es lenta para una matriz grande (100,000 x 500):

out <- NULL
for(i in 1:length(v)){
out <- rbind(out,c(rep(1, v[i]),rep(0,9-v[i])))
}

¿Alguien tiene una idea para una forma más rápida de crear dicha matriz?

Answer 1

Aquí está mi enfoque usando sapply y do.call y algunos tiempos en una muestra pequeña.

library(microbenchmark)
library(Matrix)
v <- c(2,6,3,9)
microbenchmark(
roman = {
xy <- sapply(v, FUN = function(x, ncols) {
c(rep(1, x), rep(0, ncols - x))
}, ncols = 9, simplify = FALSE)
xy <- do.call("rbind", xy)
},
fourtytwo = {
t(vapply(v, function(y) { x <- numeric( length=9); x[1:y] <- 1;x}, numeric(9) ) )
},
akrun = {
m1 <- sparseMatrix(i = rep(seq_along(v), v), j = sequence(v), x = 1)
m1 <- as.matrix(m1)
})
Unit: microseconds
expr min lq mean median uq
roman 26.436 30.0755 36.42011 36.2055 37.930
fourtytwo 43.676 47.1250 55.53421 54.7870 57.852
akrun 1261.634 1279.8330 1501.81596 1291.5180 1318.720

y para una muestra un poco más grande

v <- sample(2:9, size = 10e3, replace = TRUE)
Unit: milliseconds
expr min lq mean median uq
roman 33.52430 35.80026 37.28917 36.46881 37.69137
fourtytwo 37.39502 40.10257 41.93843 40.52229 41.52205
akrun 10.00342 10.34306 10.66846 10.52773 10.72638

Con un tamaño de objeto en crecimiento, los beneficios de spareMatrix salen a la luz.

Answer 2

Una opción es sparseMatrix de Matrix

library(Matrix)
m1 <- sparseMatrix(i = rep(seq_along(v), v), j = sequence(v), x = 1)
m1
#4 x 9 sparse Matrix of class "dgCMatrix"
#[1,] 1 1 . . . . . . .
#[2,] 1 1 1 1 1 1 . . .
#[3,] 1 1 1 . . . . . .
#[4,] 1 1 1 1 1 1 1 1 1

Esto se puede convertir a matrix con as.matrix

as.matrix(m1)

Answer 3

vapply es generalmente más rápido que sapply . Esto asigna el número deseado de unidades a un vector de longitud 9 y luego se transpone.

> t( vapply( c(2,6,3,9), function(y) { x <- numeric( length=9); x[1:y] <- 1;x}, numeric(9) ) )
[,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9]
[1,] 1 1 0 0 0 0 0 0 0
[2,] 1 1 1 1 1 1 0 0 0
[3,] 1 1 1 0 0 0 0 0 0
[4,] 1 1 1 1 1 1 1 1 1

Menos de 5 segundos en una vieja Mac.

 system.time( M <- t( vapply( sample(1:500, 100000, rep=TRUE), function(y) { x <- numeric( length=500); x[1:y] <- 1;x}, numeric(500) ) ) )
user system elapsed
3.531 1.208 4.676 

Answer 4

Actualización el 24-11-2016

Obtuve otra solución al responder a las filas de Ragged en R hoy:

outer(v, 1:9, ">=") + 0L
# [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9]
#[1,] 1 1 0 0 0 0 0 0 0
#[2,] 1 1 1 1 1 1 0 0 0
#[3,] 1 1 1 0 0 0 0 0 0
#[4,] 1 1 1 1 1 1 1 1 1

Esto tiene el mismo uso de memoria para la función f en mi respuesta inicial, y no será más lento que f . Considere el punto de referencia en mi respuesta original:

microbenchmark(my_old = f(v, n), my_new = outer(v, n, ">=") + 0L, unit = "ms")
#Unit: milliseconds
# expr min lq mean median uq max neval cld
# my_old 109.3422 111.0355 121.0382120 111.16752 112.44472 210.36808 100 b
# my_new 0.3094 0.3199 0.3691904 0.39816 0.40608 0.45556 100 a 

Tenga en cuenta cuánto más rápido es este nuevo método, sin embargo, mi antiguo método ya es el más rápido entre las soluciones existentes (ver más abajo)!

Respuesta original el 2016-11-07

Aquí está mi solución "incómoda":

f <- function (v, n) {
# n <- 9 ## total number of column
# v <- c(2,6,3,9) ## number of 1 each row
u <- n - v ## number of 0 each row
m <- length(u) ## number of rows
d <- rep.int(c(1,0), m) ## discrete value for each row
asn <- rbind(v, u) ## assignment of `d`
fill <- rep.int(d, asn) ## matrix elements
matrix(fill, byrow = TRUE, ncol = n)
}
n <- 9 ## total number of column
v <- c(2,6,3,9) ## number of 1 each row
f(v, n)
# [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9]
#[1,] 1 1 0 0 0 0 0 0 0
#[2,] 1 1 1 1 1 1 0 0 0
#[3,] 1 1 1 0 0 0 0 0 0
#[4,] 1 1 1 1 1 1 1 1 1

Consideramos un punto de referencia de gran tamaño de problema:

n <- 500 ## 500 columns
v <- sample.int(n, 10000, replace = TRUE) ## 10000 rows
microbenchmark(
my_bad = f(v, n),
roman = {
xy <- sapply(v, FUN = function(x, ncols) {
c(rep(1, x), rep(0, ncols - x))
}, ncols = n, simplify = FALSE)
do.call("rbind", xy)
},
fourtytwo = {
t(vapply(v, function(y) { x <- numeric( length=n); x[1:y] <- 1;x}, numeric(n) ) )
},
akrun = {
sparseMatrix(i = rep(seq_along(v), v), j = sequence(v), x = 1)
},
unit = "ms")
#Unit: milliseconds
# expr min lq mean median uq max neval cld
# my_bad 105.7507 118.6946 160.6818 138.5855 186.3762 327.3808 100 a
# roman 176.9003 194.7467 245.0450 213.8680 305.9537 435.5974 100 b
# fourtytwo 235.0930 256.5129 307.3099 273.2280 358.8224 587.3256 100 c
# akrun 316.7131 351.6184 408.5509 389.9576 456.0704 604.2667 100 d

¡Mi método es, de hecho, el más rápido!