Variables ficticias de una variable de cadena

Me gustaría crear variables ficticias desde este conjunto de datos:

DF DF AB 1 1 1,3,2 2 2 2,1,3,6 3 3 3,2,5,1,7 4 4 3,7,4,2,6,5 5 5 4,10,7,3,5,6 

La salida deseada debería verse así:

 A 1 2 3 4 5 6 7 8 9 10 1 1 1 1 0 0 0 0 0 0 0 2 1 1 1 0 0 1 0 0 0 0 3 1 1 1 0 1 0 1 0 0 0 4 0 1 1 1 1 1 1 0 0 0 5 0 0 1 1 1 1 1 0 0 1 

¿Hay una manera eficiente de hacer tal cosa? Puedo usar strsplit o strsplit . El conjunto de datos original es muy grande con muchas filas (> 10k) y valores en la columna B (> 15k). La dummies dummy función de los dummies paquete no funciona como yo quiero.

También encontré un caso similar: dividir una columna en varias columnas . Pero los indicadores del enlace de arriba funcionan muy lento en mi caso (hasta 15 minutos en mi Dell i7-2630QM, 8 Gb, Win7 de 64 bits, R 2.15.3 de 64 bits).

Gracias de antemano por sus artículos.

ACTUALIZAR

La función aquí mencionada ahora se ha movido a un paquete disponible en CRAN llamado “splitstackshape”. La versión en CRAN es considerablemente más rápida que esta versión original. Las velocidades deberían ser similares a las que obtendría con la solución directa for bucle al final de esta respuesta. Vea la respuesta de @ Ricardo para los puntos de referencia detallados.

Instálelo y use concat.split.expanded para obtener el resultado deseado:

 library(splitstackshape) concat.split.expanded(DF, "B", fill = 0, drop = TRUE) # A B_01 B_02 B_03 B_04 B_05 B_06 B_07 B_08 B_09 B_10 # 1 1 1 1 1 0 0 0 0 0 0 0 # 2 2 1 1 1 0 0 1 0 0 0 0 # 3 3 1 1 1 0 1 0 1 0 0 0 # 4 4 0 1 1 1 1 1 1 0 0 0 # 5 5 0 0 1 1 1 1 1 0 0 1 

Publicación original

Hace un tiempo, había escrito una función para hacer no solo este tipo de división, sino otras. La función, llamada concat.split() , se puede encontrar aquí .

El uso, para su información de ejemplo, sería:

 ## Keeping the original column concat.split(DF, "B", structure="expanded") # AB B_1 B_2 B_3 B_4 B_5 B_6 B_7 B_8 B_9 B_10 # 1 1 1,3,2 1 1 1 NA NA NA NA NA NA NA # 2 2 2,1,3,6 1 1 1 NA NA 1 NA NA NA NA # 3 3 3,2,5,1,7 1 1 1 NA 1 NA 1 NA NA NA # 4 4 3,7,4,2,6,5 NA 1 1 1 1 1 1 NA NA NA # 5 5 4,10,7,3,5,6 NA NA 1 1 1 1 1 NA NA 1 ## Dropping the original column concat.split(DF, "B", structure="expanded", drop.col=TRUE) # A B_1 B_2 B_3 B_4 B_5 B_6 B_7 B_8 B_9 B_10 # 1 1 1 1 1 NA NA NA NA NA NA NA # 2 2 1 1 1 NA NA 1 NA NA NA NA # 3 3 1 1 1 NA 1 NA 1 NA NA NA # 4 4 NA 1 1 1 1 1 1 NA NA NA # 5 5 NA NA 1 1 1 1 1 NA NA 1 

Recodificar NA a 0 tiene que hacerse manualmente; quizás actualice la función para agregar una opción y, al mismo tiempo, implemente una de estas soluciones más rápidas 🙂

 temp <- concat.split(DF, "B", structure="expanded", drop.col=TRUE) temp[is.na(temp)] <- 0 temp # A B_1 B_2 B_3 B_4 B_5 B_6 B_7 B_8 B_9 B_10 # 1 1 1 1 1 0 0 0 0 0 0 0 # 2 2 1 1 1 0 0 1 0 0 0 0 # 3 3 1 1 1 0 1 0 1 0 0 0 # 4 4 0 1 1 1 1 1 1 0 0 0 # 5 5 0 0 1 1 1 1 1 0 0 1 

Actualizar

La mayor parte de la sobrecarga en la función concat.split probablemente viene en cosas como la conversión de una matrix a un data.frame , el cambio de nombre de las columnas, y así sucesivamente. El código real utilizado para dividir es un ciclo GASP for , pero pruébelo, y verá que funciona bastante bien:

 b = strsplit(DF$B, ",") ncol = max(as.numeric(unlist(b))) temp = lapply(b, as.numeric) ## Set up an empty matrix m = matrix(0, nrow = nrow(DF), ncol = ncol) ## Fill it in for (i in 1:nrow(DF)) { m[i, temp[[i]]] = 1 } ## View your result m 

Actualizar:

Puntos de referencia adicionales a continuación
Actualización2: agregó bechmarks para la solución de @ Anada. ¡WOW, es rápido! Puntos de referencia adicionales para un conjunto de datos más grandes y la solución de @ Anada se adelanta por un margen más amplio. ‘


Respuesta original: Como puede ver a continuación, KnownMax y UnknownMax están superando incluso a la solución data.table . Aunque, sospecho que si hubiera 10e6 + filas, entonces la solución data.table sería la más rápida. (siéntase libre de compararlo simplemente modificando los parámetros en la parte inferior de esta publicación)


Solución 1: KnownMax

Si conoce el valor máximo en B, entonces tiene un buen, dos líneas:

 maximum <- 10 results <- t(sapply(strsplit(DF$B, ","), `%in%`, x=1:maximum)) + 0 # [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] # [1,] 1 1 1 0 0 0 0 0 0 0 # [2,] 1 1 1 0 0 1 0 0 0 0 # [3,] 1 1 1 0 1 0 1 0 0 0 # [4,] 0 1 1 1 1 1 1 0 0 0 # [5,] 0 0 1 1 1 1 1 0 0 1 

Tres líneas, si quiere nombrar las columnas y filas:

 dimnames(results) <- list(seq(nrow(results)), seq(ncol(results))) 

Solución 2: UnknownMax

 # if you do not know the maximum ahead of time: splat <- strsplit(DF$B, ",") maximum <- max(as.numeric(unlist(splat))) t(sapply(splat, `%in%`, x=1:maximum)) + 0 

Solución 3: DT

Según la solicitud de @dickoa, aquí hay una opción con data.table . '

 DT <- data.table(DF) DT.long <- DT[, list(vals=as.numeric(unlist(strsplit(B, ",")))), by=A] cols <- DT.long[, max(vals)] rows <- DT.long[, max(A)] matrix(as.numeric(DT.long[, (1:cols) %in% vals, by=A]$V1), ncol=cols, byrow=TRUE, dimnames=list(seq(rows), seq(cols))) # 1 2 3 4 5 6 7 8 9 10 # 1 1 1 1 0 0 0 0 0 0 0 # 2 1 1 1 0 0 1 0 0 0 0 # 3 1 1 1 0 1 0 1 0 0 0 # 4 0 1 1 1 1 1 1 0 0 0 # 5 0 0 1 1 1 1 1 0 0 1 

Una configuración similar se puede hacer en la base R también

===


Aquí hay algunos puntos de referencia con datos un poco más grandes:

 microbenchmark(KnownMax = eval(KnownMax), UnknownMax = eval(UnknownMax), DT.withAssign = eval(DT.withAssign), DT.withOutAssign = eval(DT.withOutAssign), lapply.Dickoa = eval(lapply.Dickoa), apply.SimonO101 = eval(apply.SimonO101), forLoop.Ananda = eval(forLoop.Ananda), times=50L) 

Usando OP data.frame, donde el resultado es 5 x 10

  Unit: microseconds expr min lq median uq max neval KnownMax 106.556 114.692 122.4915 129.406 6427.521 50 UnknownMax 114.470 122.561 128.9780 136.384 158.346 50 DT.withAssign 3000.777 3099.729 3198.8175 3291.284 10415.315 50 DT.withOutAssign 2637.023 2739.930 2814.0585 2903.904 9376.747 50 lapply.Dickoa 7031.791 7315.781 7438.6835 7634.647 14314.687 50 apply.SimonO101 430.350 465.074 487.9505 522.938 7568.442 50 forLoop.Ananda 81.415 91.027 99.7530 104.588 265.394 50 

Usando el data.frame un poco más grande (a continuación) donde los resultados son 1000 x 100 eliminando lapply.Dickoa ya que mi edición podría haberla ralentizado y, como estaba en pie, se colgó.

  Unit: milliseconds expr min lq median uq max neval KnownMax 34.83210 35.59068 36.13330 38.15960 52.27746 50 UnknownMax 36.41766 37.17553 38.03075 47.71438 55.57009 50 DT.withAssign 31.95005 32.65798 33.73578 43.71493 50.05831 50 DT.withOutAssign 31.36063 32.08138 32.80728 35.32660 51.00037 50 apply.SimonO101 78.61677 91.72505 95.53592 103.36052 163.14346 50 forLoop.Ananda 13.61827 14.02197 14.18899 14.58777 26.42266 50 

Incluso un conjunto más grande donde los resultados son de 10,000 x 600

 Unit: milliseconds expr min lq median uq max neval KnownMax 1583.5902 1631.6214 1658.6168 1724.9557 1902.3923 50 UnknownMax 1597.1215 1655.9634 1690.7550 1735.5913 1804.2156 50 DT.withAssign 586.4675 641.7206 660.7330 716.0100 1193.4806 50 DT.withOutAssign 587.0492 628.3731 666.3148 717.5575 776.2671 50 apply.SimonO101 1916.6589 1995.2851 2044.9553 2079.6754 2385.1028 50 forLoop.Ananda 163.4549 172.5627 182.6207 211.9153 315.0706 50 

Usando lo siguiente:

 library(microbmenchmark) library(data.table) KnownMax <- quote(t(sapply(strsplit(DF$B, ","), `%in%`, x=1:maximum)) + 0) UnknownMax <- quote({ splat <- strsplit(DF$B, ","); maximum <- max(as.numeric(unlist(splat))); t(sapply(splat, `%in%`, x=1:maximum)) + 0}) DT.withAssign <- quote({DT <- data.table(DF); DT.long <- DT[, list(vals=as.numeric(unlist(strsplit(B, ",")))), by=A]; cols <- DT.long[, max(vals)]; rows <- DT.long[, max(A)] ; matrix(as.numeric(DT.long[, (1:cols) %in% vals, by=A]$V1), ncol=cols, byrow=TRUE, dimnames=list(seq(rows), seq(cols)))}) DT.withOutAssign <- quote({DT.long <- DT[, list(vals=as.numeric(unlist(strsplit(B, ",")))), by=A]; cols <- DT.long[, max(vals)]; rows <- DT.long[, max(A)] ; matrix(as.numeric(DT.long[, (1:cols) %in% vals, by=A]$V1), ncol=cols, byrow=TRUE, dimnames=list(seq(rows), seq(cols)))}) lapply.Dickoa <- quote({ tmp <- strsplit(DF$B, ","); label <- 1:max(as.numeric(unlist(tmp))); tmp <- lapply(tmp, function(x) as.data.frame(lapply(label, function(y) (x == y)))); unname(t(sapply(tmp, colSums))) }) apply.SimonO101 <- quote({cols <- 1:max( as.numeric( unlist(strsplit(DF$B,",")))); t(apply(DF["B"] , 1 , function(x) ifelse( cols %in% as.numeric( unlist( strsplit(x , ",") ) ) , 1 , 0 ) ) ) }) forLoop.Ananda <- quote({b = strsplit(DF$B, ","); ncol = max(as.numeric(unlist(b))); temp = lapply(b, as.numeric); m = matrix(0, nrow = nrow(DF), ncol = ncol)    ; for (i in 1:nrow(DF)) {  m[i, temp[[i]]] = 1 }; m }) # slightly modified @Dickoa's alogrithm to allow for instances were B is only a single number. # Instead of using `sapply(.)`, I used `as.data.frame(lapply(.))` which hopefully the simplification process in sapply is analogous in time to `as.data.frame` identical(eval(lapply.Dickoa), eval(UnknownMax)) identical(eval(lapply.Dickoa), unname(eval(apply.SimonO101))) identical(eval(lapply.Dickoa), eval(KnownMax)) identical(unname(as.matrix(eval(DT.withAssign))), eval(KnownMax)) # ALL TRUE 

esto es lo que se usó para crear los datos de muestra:

 # larger data created as follows set.seed(1) maximum <- 600 rows <- 10000 DF <- data.frame(A=seq(rows), B=as.character(c(maximum, replicate(rows-1, paste(sample(maximum, sample(20), FALSE), collapse=",")))), stringsAsFactors=FALSE) DT <- data.table(DF); DT 

Una forma de hacerlo con strsplit y strsplit (a menos que no lo haya entendido bien y no quiera usarlos) es así …

 cols <- 1:max( as.numeric( unlist(strsplit(DF$B,",")))) df <- t(apply(DF["B"] , 1 , function(x) ifelse( cols %in% as.numeric( unlist( strsplit(x , ",") ) ) , 1 , 0 ) ) ) colnames(df) <- cols df # 1 2 3 4 5 6 7 8 9 10 #1 1 1 1 0 0 0 0 0 0 0 #2 1 1 1 0 0 1 0 0 0 0 #3 1 1 1 0 1 0 1 0 0 0 #4 0 1 1 1 1 1 1 0 0 0 #5 0 0 1 1 1 1 1 0 0 1 

La idea es que obtengamos un vector de los valores únicos en su columna deseada, busquemos el valor max y creemos un vector 1:max(value) luego apliquemos en cada fila para descubrir qué valores para esa fila están en el vector de todos valores. Usamos ifelse para poner un 1 si está allí y 0 si no lo está. El vector que coincidimos es una secuencia, por lo que su salida está lista ordenada.

Un poco tarde para el juego, pero una estrategia diferente usa el hecho de que una matriz puede ser indexada por otra matriz de dos columnas que especifique los índices de fila y columna para la actualización. Asi que

 f2 <- function(DF) { b <- strsplit(DF$B, ",", fixed=TRUE) len <- vapply(b, length, integer(1)) # 'geometry' b <- as.integer(unlist(b)) midx <- matrix(c(rep(seq_len(nrow(DF)), len), b), ncol=2) m <- matrix(0L, nrow(DF), max(b)) m[midx] <- 1L m } 

Esto usa strsplit(..., fixed=TRUE) y vapply para eficiencia y tipo de seguridad, y as.integer y as.integer , 1L porque realmente queremos enteros y no valores numéricos de retorno.

A modo de comparación, aquí está la implementación original de @AnandaMahto

 f0 <- function(DF) { b = strsplit(DF$B, ",") ncol = max(as.numeric(unlist(b))) temp = lapply(b, as.numeric) m = matrix(0, nrow = nrow(DF), ncol = ncol) for (i in 1:nrow(DF)) { m[i, temp[[i]]] = 1 } m } 

Esto se puede mejorar para la eficiencia mediante el uso de fixed=TRUE y evitando la doble coerción de b , y se hace más robusto forzando al entero y usando seq_len(nrow(DF)) para evitar el caso de esquina de DF de 0 filas

 f1 <- function(DF) { b = lapply(strsplit(DF$B, ",", fixed=TRUE), as.integer) ncol = max(unlist(b)) m = matrix(0L, nrow = nrow(DF), ncol = ncol) for (i in seq_len(nrow(DF))) m[i, b[[i]]] = 1L m } 

El bucle for es un buen candidato para la comstackción, por lo que

 library(compiler) f1c <- cmpfun(f1) 

y luego para comparar los datos de 10,000 x 600 de @RicardoSaporta

 > library(microbenchmark) > microbenchmark(f0(DF), f1(DF), f1c(DF), f2(DF)) Unit: milliseconds expr min lq median uq max neval f0(DF) 170.51388 180.25997 182.45772 188.23811 717.7511 100 f1(DF) 91.53578 97.14909 97.97195 100.24236 447.5900 100 f1c(DF) 79.39194 84.45712 85.71022 87.85763 411.8340 100 f2(DF) 76.45496 81.70307 82.50752 110.83620 398.6093 100 

Tanto el aumento de 2 veces de f0 a f1 como la eficiencia relativa del bucle for fueron relativamente sorprendentes para mí. La solución de @AnandaMahto es más eficiente en la memoria, más sin costos de rendimiento

 ncol = max(vapply(b, max, integer(1))) 

Sé que ya hay una respuesta buena y bastante eficiente, pero también podemos utilizar otro enfoque para obtener los mismos resultados.

 tmp <- strsplit(DF$B, ",") label <- 1:max(as.numeric(unlist(tmp))) tmp <- lapply(tmp, function(x) sapply(label, function(y) (x == y))) t(sapply(tmp, colSums)) ## [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] ## [1,] 1 1 1 0 0 0 0 0 0 0 ## [2,] 1 1 1 0 0 1 0 0 0 0 ## [3,] 1 1 1 0 1 0 1 0 0 0 ## [4,] 0 1 1 1 1 1 1 0 0 0 ## [5,] 0 0 1 1 1 1 1 0 0 1 

Podemos compararlo ahora para compararlo con la solución @ SimonO101 (fun2)

 require(rbenchmark) fun1 <- function(DF) { tmp <- strsplit(DF$B, ",") label <- 1:max(as.numeric(unlist(tmp))) tmp <- lapply(tmp, function(x) sapply(label, function(y) (x == y))) t(sapply(tmp, colSums)) } fun2 <- function(DF) { cols <- 1:max( as.numeric( unlist(strsplit(DF$B,",")))) df <- t(apply(DF["B"] , 1 , function(x) ifelse( cols %in% as.numeric( unlist( strsplit(x , ",") ) ) , 1 , 0 ) ) ) colnames(df) <- cols df } all.equal(fun1(DF), fun2(DF), check.attributes = FALSE) ## [1] TRUE benchmark(fun1(DF), fun2(DF), order = "elapsed", columns = c("test", "elapsed", "relative"), replications = 5000) ## test elapsed relative ## 1 fun1(DF) 1.870 1.000 ## 2 fun2(DF) 2.018 1.079 

Como podemos ver, no hay una gran diferencia.


Edición sugerida (RS):

 # from: tmp <- lapply(tmp, function(x) sapply(label, function(y) (x == y))) # to: tmp <- lapply(tmp, function(x) as.data.frame(lapply(label, function(y) (x == y)))) 

Ok, esto me ha estado molestando por un tiempo, pero pensé que sería un buen uso de Rcpp . Así que escribí una pequeña función para ver si puedo obtener algo más rápido que la asombrosa solución de loop de @Ananda. Esta solución parece ejecutarse aproximadamente el doble de rápido (utilizando el conjunto de datos de muestra más grande publicado por @RicardoSaporta).

Nota: Estaba intentando esto más para enseñarme cómo usar Rcpp y C ++ que para proporcionar una solución útil, pero de todos modos …

Nuestro archivo .cpp

 #include  #include  #include  using namespace Rcpp; //[[Rcpp::export]] NumericMatrix expandR(CharacterVector x) { int n = x.size(); std::vector< std::vector > out; // list to hold numeric vectors int tmax = 0; for(int i = 0; i < n; ++i) { std::vector vect; // vector to hold split strings std::string str = as(x[i]); std::stringstream ss(str); int j = 0; while (ss >> j) { vect.push_back(j); // add integer to result vector if (ss.peek() == ',') //split by ',' delim ss.ignore(); } int it = *std::max_element(vect.begin(), vect.end()); if( it > tmax ) tmax = it; //current max value out.push_back(vect); } // Now we construct the matrix. tmax gives us number of columns, n is number of rows; NumericMatrix mat(n,tmax); for( int i = 0; i < n; ++i) { NumericMatrix::Row zzrow = mat( i , _ ); std::vector vec = out[i]; for( int j = 0; j < vec.size(); ++j ) { zzrow[ (vec[j]-1) ] = 1; //don't forget R vs. C++ indexing } } return mat; } 

Usando el ejemplo nominal del OP, podemos simplemente hacer ...

 require(Rcpp) ## source the function so it is available to use in R sourceCpp("C:/path/to/file.cpp") # Call it like any other R function expandR(DF$B) [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [1,] 1 1 1 0 0 0 0 0 0 0 [2,] 1 1 1 0 0 1 0 0 0 0 [3,] 1 1 1 0 1 0 1 0 0 0 [4,] 0 1 1 1 1 1 1 0 0 0 [5,] 0 0 1 1 1 1 1 0 0 1 

Y usando el conjunto de datos más grande provisto por @Ricardo) y comparando con la solución de @Ananda) ....

 require(Rcpp) require(data.table) set.seed(1) maximum <- 600 rows <- 10000 DF <- data.frame(A=seq(rows), B=as.character(c(maximum, replicate(rows-1, paste(sample(maximum, sample(20), FALSE), collapse=",")))), stringsAsFactors=FALSE) DT <- data.table(DF); DT ## source in our c code sourceCpp("C:/Users/sohanlon/Desktop/expandR2.cpp") forLoop.Ananda <- quote({b = strsplit(DF$B, ","); ncol = max(as.numeric(unlist(b))); temp = lapply(b, as.numeric); m = matrix(0, nrow = nrow(DF), ncol = ncol) ; for (i in 1:nrow(DF)) { m[i, temp[[i]]] = 1 }; m }) rcpp.Simon <- quote({mm = expandR( DT$B )}) require(microbenchmark) microbenchmark( eval(forLoop.Ananda) , eval(rcpp.Simon) , times = 5L ) Unit: milliseconds expr min lq median uq max neval eval(forLoop.Ananda) 173.3024 178.6445 181.5881 218.9619 227.9490 5 eval(rcpp.Simon) 115.8309 116.3876 116.8125 119.1971 125.6504 5