将因子矩阵转换为R中的二进制(指标)矩阵的最有效方法

时间:2016-04-10 15:24:01

标签: r matrix binary

我可以想到几种方法来转换这种类型的矩阵(数据框):

    dat = data.frame(
    x1 = rep(c('a', 'b'), 100),
    x2 = rep(c('x', 'y'), 100)
)

head(dat)
  x1 x2
1  a  x
2  b  y
3  a  x
4  b  y
5  a  x
6  b  y

进入二进制(指标)矩阵(或数据框),如下所示:

a  b  x  y
1  0  1  0
0  1  0  1
...

(这种结构当然是微不足道的,仅用于说明目的!)

非常感谢!

3 个答案:

答案 0 :(得分:4)

我们可以使用table

tbl <- table(rep(1:nrow(dat),2),unlist(dat))
head(tbl, 2)
#    a b x y
#  1 1 0 1 0
#  2 0 1 0 1

或者可能有效的选择

library(Matrix)
sM <- sparse.model.matrix(~ -1 + x1 +x2, dat, 
      contrasts.arg = lapply(dat, contrasts, contrasts = FALSE))
colnames(sM) <- sub(".*\\d", "", colnames(sM))
head(sM, 2)
# 2 x 4 sparse Matrix of class "dgCMatrix"
# a b x y
#1 1 . 1 .
#2 . 1 . 1

转换为matrix

可将其转换为二进制
head(as.matrix(sM),2)  
#  a b x y
#1 1 0 1 0
#2 0 1 0 1

答案 1 :(得分:3)

已经发布了一些好的解决方案,但没有一个是最佳的性能。我们可以通过循环每个输入列来优化性能,然后在每个输入列中循环每个因子级索引并对因子索引进行直接整数比较。它不是最简洁或优雅的代码,但它相当简单快捷:

do.call(cbind,lapply(dat,function(col)
    `colnames<-`(do.call(cbind,lapply(seq_along(levels(col)),function(i)
        as.integer(as.integer(col)==i)
    )),levels(col))
));

性能:

library(Matrix);
library(data.table);
library(microbenchmark);

bgoldst <- function(dat) do.call(cbind,lapply(dat,function(col) `colnames<-`(do.call(cbind,lapply(seq_along(levels(col)),function(i) as.integer(as.integer(col)==i))),levels(col))));
akrun1 <- function(dat) table(rep(1:nrow(dat),2),unlist(dat));
akrun2 <- function(dat) sparse.model.matrix(~-1+x1+x2,dat,contrasts.arg=lapply(dat,contrasts,contrasts=FALSE));
davidar <- function(dat) { dat[,rowid:=.I]; dcast(melt(dat,id='rowid'),rowid~value,length); }; ## requires a data.table
dataminer <- function(dat) t(apply(dat,1,function(x) as.numeric(unique(unlist(dat))%in%x)));

N <- 100L; dat <- data.frame(x1=rep(c('a','b'),N),x2=rep(c('x','y'),N)); datDT <- setDT(copy(dat));
identical(unname(bgoldst(dat)),matrix(as.vector(akrun1(dat)),ncol=4L));
## [1] TRUE
identical(unname(bgoldst(dat)),unname(matrix(as.integer(as.matrix(akrun2(dat))),ncol=4L)));
## [1] TRUE
identical(bgoldst(dat),as.matrix(davidar(datDT)[,rowid:=NULL]));
## [1] TRUE
identical(unname(bgoldst(dat)),matrix(as.integer(dataminer(dat)),ncol=4L));
## [1] TRUE
N <- 100L;
dat <- data.frame(x1=rep(c('a','b'),N),x2=rep(c('x','y'),N)); datDT <- setDT(copy(dat));
microbenchmark(bgoldst(dat),akrun1(dat),akrun2(dat),davidar(datDT),dataminer(dat));
## Unit: microseconds
##            expr       min        lq       mean     median         uq       max neval
##    bgoldst(dat)    67.570    92.374   106.2853    99.6440   121.2405   188.596   100
##     akrun1(dat)   581.182   652.386   773.6300   690.6605   916.4625  1192.299   100
##     akrun2(dat)  4429.208  4836.119  5554.5902  5145.3135  5977.0990 11263.537   100
##  davidar(datDT)  5064.273  5498.555  6104.7621  5664.9115  6203.9695 11713.856   100
##  dataminer(dat) 47577.729 49529.753 55217.3726 53190.8940 60041.9020 74346.268   100

N <- 1e4L;
dat <- data.frame(x1=rep(c('a','b'),N),x2=rep(c('x','y'),N)); datDT <- setDT(copy(dat));
microbenchmark(bgoldst(dat),akrun1(dat),akrun2(dat),davidar(datDT));
## Unit: milliseconds
##            expr       min        lq      mean   median        uq        max neval
##    bgoldst(dat)  1.775617  1.820949  2.299493  1.84725  1.972124   8.362336   100
##     akrun1(dat) 38.954524 41.109257 48.409613 45.60304 52.147633 162.365472   100
##     akrun2(dat) 16.915832 17.762799 21.288200 19.20164 23.775180  46.494055   100
##  davidar(datDT) 36.151684 38.366715 42.875940 42.38794 45.916937  58.695008   100

N <- 1e5L;
dat <- data.frame(x1=rep(c('a','b'),N),x2=rep(c('x','y'),N)); datDT <- setDT(copy(dat));
microbenchmark(bgoldst(dat),akrun1(dat),akrun2(dat),davidar(datDT));
## Unit: milliseconds
##            expr       min        lq      mean    median        uq      max neval
##    bgoldst(dat)  17.16473  22.97654  35.01815  26.76662  31.75562 152.6188   100
##     akrun1(dat) 501.72644 626.14494 671.98315 680.91152 727.88262 828.8313   100
##     akrun2(dat) 212.12381 242.65505 298.90254 272.28203 357.65106 429.6023   100
##  davidar(datDT) 368.04924 461.60078 500.99431 511.54921 540.39358 638.3840   100

答案 2 :(得分:1)

使用apply

的一种替代方法
head(t(apply(dat,1, function(x) as.numeric(unique(unlist(dat)) %in% x))))
     [,1] [,2] [,3] [,4]
[1,]    1    0    1    0
[2,]    0    1    0    1
[3,]    1    0    1    0
[4,]    0    1    0    1
[5,]    1    0    1    0
[6,]    0    1    0    1