행의 알려진 개수가 1 인 이진 행렬을 만드는 빠른 방법 R

Question

행렬의 각 행에 "1"이 얼마나 많은지를 나타내는 벡터가 있습니다. 이제 벡터에서이 행렬을 만들어야합니다.

예를 들어, 벡터 v <- c(2,6,3,9)을 사용하여 4 x 9 매트릭스 out을 만들고 싶다고합시다.

out <- NULL 
for(i in 1:length(v)){ 
    out <- rbind(out,c(rep(1, v[i]),rep(0,9-v[i]))) 
} 

은 빠른에 대한 아이디어를 사람이 있습니다 결과는 내가 for 루프 이런 짓을 한

 [,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 

과 같아야하지만 내 솔루션은 대형 매트릭스 (10 X 500)에 대한 느린 그런 행렬을 만드는 방법?

Answer 1

여기 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 

와 조금 더 큰 샘플 성장하는 대상물의 크기와

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의 장점은 빛에 온다.

Answer 2

하나의 옵션은 sparseMatrix

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로 변환 할 수 있습니다 Matrix에서 as.matrix

as.matrix(m1) 

Answer 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 

Answer 4

Ragged rowSums in R에 응답 할 때 나는 오늘 다른 해결책을 가지고 2016년 11월 24일

에 업데이트 :

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 

참고이 새로운 방법은, 아직 나의 오래된 방법은 기존의 솔루션 중 가장 빠른 얼마나 빨리 (아래 참조)!

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 

: 우리는 큰 문제 크기의 기준을 고려

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 

: 여기 2016년 11월 7일

에

---

원래 대답은 내 "어색"솔루션입니다

내 방법이 실제로 가장 빠릅니다!