在R中创建每行已知数量为1的二进制矩阵的快速方法

时间:2016-11-07 09:06:50

标签: r matrix

我有一个向量,提供多少" 1"矩阵的每一行都有。现在我必须从向量中创建这个矩阵。

例如,假设我要创建一个带有跟随向量out的4 x 9矩阵v <- c(2,6,3,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

我用for循环完成了这项工作,但对于大型矩阵(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])))
}

有没有人想要更快的方法来创建这样的矩阵?

4 个答案:

答案 0 :(得分:5)

2016-11-24更新

我今天在回答Ragged rowSums in R时得到了另一种解决方案:

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

这与我的初始答案中的f函数具有相同的内存使用量,并且它不会比f慢。在我原来的答案中考虑基准:

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 

注意这种新方法的速度有多快,但我的旧方法已经是现有解决方案中最快的方法(见下文)!!!

2016-11-07的原始答案

这是我的&#34;尴尬&#34;溶液:

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

我们考虑大问题规模的基准:

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

我的方法实际上是最快的!!

答案 1 :(得分:4)

以下是我使用sapplydo.call的方法以及一些小样本的时间安排。

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

以及更大的样本

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

随着对象大小的增加,spareMatrix的好处被曝光。

答案 2 :(得分:3)

一个选项是来自sparseMatrix

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

可以使用matrix

将其转换为as.matrix
as.matrix(m1)

答案 3 :(得分:3)

vapply通常比sapply更快。这会将所需数量的1分配给长度为9的向量,然后进行转置。

> 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

旧Mac上不到5秒钟。

 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