创建一个二进制矩阵的快速方法,该矩阵在R中的每行数为1

创建一个二进制矩阵的快速方法,该矩阵在R中的每行数为1,r,matrix,R,Matrix,我有一个向量,它提供了矩阵每行有多少个“1”。现在我要用向量创建这个矩阵 例如,假设我想创建一个4x9矩阵out,其中一个选项是sparseMatrixfrommatrix 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”。现在我要用向量创建这个矩阵


例如,假设我想创建一个4x9矩阵
out
,其中一个选项是
sparseMatrix
from
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
as.matrix(m1)

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

>t(vapply(c(2,6,3,9),函数(y){x下面是我使用
sapply
do.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
库(微基准)
图书馆(矩阵)

v2016-11-24更新

今天回答时,我得到了另一个解决方案:

<>这与我的初始答案中的<代码> 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

f我甚至不打算尝试这一点,因为akrun将在一秒钟后在data.table中提供速度快1000倍的解决方案。顺便说一句,您的解决方案很慢,因为您正在增长对象。请参阅,我告诉过您。:)@ZheyuanLi使用42-的数据,我发现1.69比
系统的2.20更快。时间
v,我模拟了大小矩阵。
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
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
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 
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