来自stringvariables的虚拟variables
我想创build这个数据集的虚拟variables：
DF<-structure(list(A = c(1, 2, 3, 4, 5), B = c("1,3,2", "2,1,3,6", "3,2,5,1,7", "3,7,4,2,6,5", "4,10,7,3,5,6")), .Names = c("A", "B"), row.names = c(NA, 5L), class = "data.frame") > 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 所需的输出应该如下所示：
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
有没有一种有效的方法来做这样的事情？ 我可以使用strsplit或ifelse 。 原始数据集非常大，有许多行（> 10k），列B中的值（> 15k）。 包装dummiesfunctiondummies不能按我的要求工作。
我也发现了类似的情况：将一列分成多列 。 但从上面的链接的工作真的很慢（我的戴尔i7-2630QM，8Gb，Win7的64位，R 2.15.3 64位）15分钟。
预先感谢您的服务员。
UPDATE
这里提到的function现在已经被转移到一个名为“splitstackshape”的CRAN上。 CRAN上的版本比原始版本快很多。 速度应该类似于你在这个答案结束时用直接for循环解决scheme得到的结果。 看@里卡多的答案详细的基准。
安装它，并使用concat.split.expanded得到所需的结果：
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
原帖
前一段时间，我写了一个function，不只是这种分裂，而是其他的。 名为concat.split()的函数可以在这里find。
您的示例数据的用法是：
## 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
将NA重新编码为0必须手动完成 – 也许我会更新函数来添加一个选项，同时实现其中一个更快的解决scheme:)
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
更新
concat.split函数中的大部分开销都可能是从matrix转换为data.frame ，重命名列等等。 用于分割的实际代码是一个GASP for循环，但是testing它，你会发现它performance相当不错：
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
更新：
下面添加了基准
Update2：为@Anada的解决scheme添加了bechmarks。 哇，它快！ 为evern更大的数据集增加了基准和@ Anada的解决scheme速度提前了更大的利润。 “
原始答案：正如您在下面看到的， KnownMax和UnknownMax即使在data.table解决scheme中也performance优异。 虽然，我怀疑如果有10e6 +行，那么data.table解决scheme将是最快的。 （只要修改这篇文章最底部的参数就可以自由地进行基准testing）
解决scheme1： KnownMax
如果你知道B的最大值，那么你有一个很好的双线：
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
三行，如果你想命名的行和列：
dimnames(results) <- list(seq(nrow(results)), seq(ncol(results)))
解决scheme2： 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
解决scheme3： DT
根据@ dickoa的要求，这里是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
类似的设置也可以在R完成
===
以下是一些数据稍大的基准：
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)
使用OP data.frame，其结果是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
使用稍大的data.frame（下），结果是1000 x 100 删除lapply.Dickoa作为我的编辑可能已经放慢了下来，因为它站在崩溃。
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
更大的一组结果是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
使用以下内容：
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
这是用来创build样本数据的：
# 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
有一种方法可以用ifelse和strsplit来做到这strsplit （除非我误解，你不想使用它们）是这样的….
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
我们的想法是，我们得到你想要的列中唯一值的向量，findmax并创build一个向量1:max(value)然后应用在每一行中找出该行的哪些值在所有向量中值。 如果有，则使用ifelse ，如果不是，则使用if。 我们匹配的vector是一个序列，所以它的输出已经准备好了。
稍晚一点，但另一种策略使用这样一个事实，即一个matrix可以由另一个指定行和列索引的两列matrix进行索引来更新。 所以
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 }
这使用strsplit(..., fixed=TRUE)和vapply效率和types安全， as.integer和0L ， 1L因为我们真的想要整数而不是数值返回值。
为了比较，这里是来自@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 }
这可以通过使用fixed=TRUE并避免b的双重强制来提高效率，并且通过强制转换为整数并使用seq_len(nrow(DF))来避免0行DF的拐angular情况
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 }
for循环是编译的好select，所以
library(compiler) f1c <- cmpfun(f1)
然后比较来自@RicardoSaporta的10,000 x 600数据
> 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
从f0到f1的2倍增加和for循环的相对效率都是相当惊人的。 @AnandaMahto的解决scheme是更高的内存效率，更没有太多的性能成本
ncol = max(vapply(b, max, integer(1)))
我知道已经有一个很好的，相当有效的答案，但我们也可以使用另一种方法来获得相同的结果。
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
我们现在可以用它来比较@ SimonO101解决scheme（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
正如我们所看到的，没有太大的区别。
build议编辑（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))))
好的，这一直在困扰我一段时间，但我认为这将是一个很好的使用Rcpp 。 所以我写了一个小function，看看我能否比@ Ananda的惊人的for循环解决scheme获得更快的速度。 这个解决scheme的运行速度似乎快了近一倍（使用@RicardoSaporta发布的更大的样本数据集）。
注：我正在尝试更多的教自己如何使用Rcpp和C ++，而不是提供一个有用的解决scheme，但都是一样的…
我们的.cpp文件…
#include <Rcpp.h> #include <string> #include <sstream> using namespace Rcpp; //[[Rcpp::export]] NumericMatrix expandR(CharacterVector x) { int n = x.size(); std::vector< std::vector<int> > out; // list to hold numeric vectors int tmax = 0; for(int i = 0; i < n; ++i) { std::vector<int> vect; // vector to hold split strings std::string str = as<std::string>(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<int> 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; }
使用OP的名义例子，我们可以做…
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
并使用@Ricardo提供的更大的数据集）和@ Ananda的解决scheme进行比较）….
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
