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

Question

我有一个向量,它提供矩阵每行有多少"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])))
}

有谁有想法以更快的方式创建这样的矩阵？

Answer 1

2016-11-24更新

我今天回答R中的Ragged rowSums时得到了另一个解决方案:

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的原始答案

这是我的"尴尬"解决方案:

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

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