Convierta un dataframe en matriz de ausencia de presencia

Tengo una tabla que tiene un número desigual de elementos en formato de cadena

File1 ABC File2 ABD File3 EF 

Quiero convertir a un formato de la siguiente manera

  ABCDEF File1 1 1 1 0 0 0 FIle2 1 1 0 1 0 0 File3 0 0 0 0 1 1 

Intenté hacerlo usando reshape2 pero no fue exitoso.

Data de muestra:

 mydata <- structure(list(V1 = c("File1", "File2", "File3"), V2 = c("A", "A", "E"), V3 = c("B", "B", "F"), V4 = c("C", "D", "")), .Names = c("V1", "V2", "V3", "V4"), class = "data.frame", row.names = c(NA, -3L)) 

Una posibilidad:

 library(reshape2) df2 <- melt(df, id.var = "V1") with(df2, table(V1, value)) # value # V1 ABCDEF # File1 1 1 1 0 0 0 # File2 1 1 0 1 0 0 # File3 0 0 0 0 1 1 

Un enfoque razonablemente eficiente es usar la función charMat (actualmente) no exportada de mi paquete “splitstackshape”. Como no se exporta, deberá usar ::: para acceder a él.

 library(splitstackshape) cbind(mydata[1], splitstackshape:::charMat( split.default(mydata[-1], sequence(ncol(mydata)-1)), fill=0)) # V1 V1 ABCDEF # 1 File1 0 1 1 1 0 0 0 # 2 File2 0 1 1 0 1 0 0 # 3 File3 1 0 0 0 0 1 1 

Bajo el capó, charMat hace uso de la indexación matricial para procesar todo de manera bastante eficiente. Paso a paso, esto es lo que hace charMat .

 X <- split.default(mydata[-1], sequence(ncol(mydata)-1)) len <- length(X) vec <- unlist(X, use.names=FALSE) lvl <- sort(unique(vec)) out <- matrix(0L, nrow = len, ncol = length(lvl), dimnames = list(NULL, lvl)) i.idx <- rep(seq.int(len), vapply(X, length, integer(1L))) j.idx <- match(vec, lvl) out[cbind(i.idx, j.idx)] <- 1 out # ABCDEF # [1,] 0 1 1 1 0 0 0 # [2,] 0 1 1 0 1 0 0 # [3,] 1 0 0 0 0 1 1 

Parece un bocado, pero en realidad es una operación bastante rápida, más rápida al usar la función charMat 🙂


Actualización: puntos de referencia

Los siguientes puntos de referencia prueban la respuesta de Henrik con mi respuesta de charMat , y también adapta la respuesta de Henrik para usar "data.table" en su lugar, para una mejor eficiencia.

Se realizaron dos pruebas. El primero está en un conjunto de datos similar con 90K filas, y el segundo en uno con 900K filas.

Aquí están los datos de muestra:

 biggerdata <- do.call(rbind, replicate(30000, mydata, simplify = FALSE)) biggerdata$V1 <- make.unique(biggerdata$V1) dim(biggerdata) # [1] 90000 4 evenBigger <- do.call(rbind, replicate(10, biggerdata, simplify = FALSE)) evenBigger$V1 <- make.unique(evenBigger$V1) dim(evenBigger) # [1] 900000 4 

Estas son las funciones de referencia:

 fun1 <- function(indf) { cbind(indf[1], splitstackshape:::charMat( split.default(indf[-1], sequence(ncol(indf)-1)), fill=0)) } library(reshape2) fun2 <- function(indf) { df2 <- melt(indf, id.var = "V1") with(df2, table(V1, value)) } library(data.table) library(reshape2) DT <- data.table(biggerdata) DT2 <- data.table(evenBigger) fun3 <- function(inDT) { DTL <- melt(inDT, id.vars="V1") dcast.data.table(DTL, V1 ~ value, fun.aggregate=length) } 

Y los resultados de la evaluación comparativa.

 library(microbenchmark) microbenchmark(fun1(biggerdata), fun2(biggerdata), fun3(DT), times = 20) # Unit: milliseconds # expr min lq median uq max neval # fun1(biggerdata) 185.3652 199.8725 289.0206 308.5826 327.4185 20 # fun2(biggerdata) 1453.8791 1605.6053 1639.8567 1758.3984 1797.2229 20 # suppressMessages(fun3(DT)) 469.8979 570.4664 586.4715 598.6229 675.2961 20 microbenchmark(fun1(evenBigger), fun2(evenBigger), fun3(DT2), times = 5) # Unit: seconds # expr min lq median uq max neval # fun1(evenBigger) 1.871611 1.896351 2.071355 2.140580 2.464569 5 # fun2(evenBigger) 26.911523 27.212910 27.363442 27.469812 27.938178 5 # fun3(DT2) 7.103615 7.131603 7.141908 7.205006 7.218321 5