基于另一个矩阵创建矩阵包含元素的索引

Question

我有一个矩阵，其中包含我要创建的矩阵元素的列 ides 索引

>  index
         [,1] [,2] [,3] 
    [1,]    1    2    3    
    [2,]    1    2    5    
    [3,]    1    3    4    
    [4,]    1    3    5    
    [5,]    1    4    5    
    [6,]    2    3    5    
    [7,]    3    4    5    

示例第一行的列 id 1 ,2 , 3 设置为它的值 1

第二行的列 id 1 , 2 , 5 设置为它的值 1

now I want to create the following matrix:


     a1 a2 a3  a4 a5
[1,]  1  1  1  0  0
[2,]  1  1  0  0  1
[3,]  1  0  1  1  0
[4,]  1  0  1  0  1
[5,]  1  0  0  1  1  
[6,]  0  1  1  0  1
[7,]  0  0  1  1  1

数据

index <- rbind(c(1,2,3), c(1,2,5), c(1,3,4), c(1,3,5), c(1,4,5), c(2,3,5), c(3,4,5))

Answer 1

这里是cmets中提到的使用矩阵索引的极其快速和高效的base R方法。

# construct 0 matrix with correct dimensions
newMat <- matrix(0L, nrow(myMat), max(myMat))

# fill in matrix using matrix indexing
newMat[cbind(c(row(myMat)), c(myMat))] <- 1L

返回

newMat
     [,1] [,2] [,3] [,4] [,5]
[1,]    1    1    1    0    0
[2,]    1    1    0    0    1
[3,]    1    0    1    1    0
[4,]    1    0    1    0    1
[5,]    1    0    0    1    1
[6,]    0    1    1    0    1
[7,]    0    0    1    1    1

数据

myMat <-
structure(c(1L, 1L, 1L, 1L, 1L, 2L, 3L, 2L, 2L, 3L, 3L, 4L, 3L, 
4L, 3L, 5L, 4L, 5L, 5L, 5L, 5L), .Dim = c(7L, 3L))

Answer 2

这是基于 R 的解决方案：

# Your sample matrix
m.idx <- matrix(c(1,1,1,1,1,2,3,2,2,3,3,4,3,4,3,5,4,5,5,5,5), ncol = 3);

# Construct empty matrix of the right dims
m.val <- matrix(0, nrow = nrow(m.idx), ncol = max(m.idx));

for (i in 1:nrow(m.idx)) m.val[i, m.idx[i, ]] <- 1;
m.val;
#     [,1] [,2] [,3] [,4] [,5]
#[1,]    1    1    1    0    0
#[2,]    1    1    0    0    1
#[3,]    1    0    1    1    0
#[4,]    1    0    1    0    1
#[5,]    1    0    0    1    1
#[6,]    0    1    1    0    1
#[7,]    0    0    1    1    1

---

更新

请参阅下文，了解此处介绍的所有方法的基准测试结果。我已经将所有方法都包装在函数中

# The original matrix with indices
m.idx <- matrix(c(1,1,1,1,1,2,3,2,2,3,3,4,3,4,3,5,4,5,5,5,5), ncol = 3);

# For loop method
method.for_loop <- function(m) {
    m.val <- matrix(0, nrow = nrow(m), ncol = max(m));
    for (i in 1:nrow(m.idx)) m.val[i, m.idx[i, ]] <- 1;
    return(m.val);
}

# lapply method (@Headpoint)
method.lapply <- function(m) {
    m.val <- as.data.frame(matrix(0, nrow = nrow(m), ncol = max(m)));
    invisible(lapply(1:nrow(m),
                   function(x) m.val[x,][m[x,]] <<- 1));
    return(m.val);
}

# Direct indexing method (@lmo)
method.indexing <- function(m) {
    m.val <- matrix(0L, nrow(m.idx), max(m.idx));
    m.val[cbind(c(row(m.idx)), c(m.idx))] <- 1L;
    return(m.val);
}

# tidyr/dplyr method (@CPak)
method.dplyr_tidyr <- function(m) {
    as.data.frame(m) %>%
      gather() %>%                   # wide-to-long format
      group_by(key) %>%
      mutate(rn = row_number()) %>%  # add unique row_id per `key` group
      mutate(newval = 1) %>%         # fill in `existing` with this value
      ungroup() %>%                  # ungroup and unselect `key` group
      select(-key) %>%
      spread(value, newval, fill=0) %>%  # long-to-wide format
                                         # fill in `non-existing` with `0`
      select(-rn) %>%                    # unselect row_id column
      rename_all(funs(paste0("a", .)))   # rename columns
}

microbenchmark 的结果如下所示。

library(microbenchmark);
library(tidyr);
library(dplyr);
library(magrittr);    

res <- microbenchmark(
    for_loop = method.for_loop(m.idx),
    lapply = method.lapply(m.idx),
    indexing = method.indexing(m.idx),
    dplyr_tidyr = method.dplyr_tidyr(m.idx),
    times = 1000L
)
print(res);
#    Unit: microseconds
#        expr       min         lq        mean    median        uq       max
#    for_loop     6.796     9.5405    16.89643    13.497    20.445    96.537
#      lapply  1315.765  1441.5990  1696.74392  1518.256  1675.027 66181.880
#    indexing     5.695     8.1450    20.49116    14.918    20.094  3139.946
# dplyr_tidyr 18777.669 20525.8095 22225.51936 21647.120 23215.714 84791.858

结论：使用 for 循环或直接索引的方法并列且最快。 lapply 次之，tidyr/dplyr 方法最慢（但请注意运行时的大幅增加）。

Answer 3

没有for 循环，但没有真正检查它是否更快。

index <- matrix(c(1,1,1,1,1,2,3,2,2,3,3,4,3,4,3,5,4,5,5,5,5), 
                                   ncol = 3)
df <- as.data.frame(matrix(0, nrow = 7, ncol = 5))

invisible(lapply(1:nrow(index), 
                   function(x) df[x,][index[x,]] <<- 1))
df
# V1 V2 V3 V4 V5
# 1  1  1  1  0  0
# 2  1  1  0  0  1
# 3  1  0  1  1  0
# 4  1  0  1  0  1
# 5  1  0  0  1  1
# 6  0  1  1  0  1
# 7  0  0  1  1  1

Answer 4

您可以通过dplyr 和tidyr 的组合来做到这一点

您的数据

df <- read.table(text="1    2    3    
1    2    5    
1    3    4    
1    3    5    
1    4    5    
2    3    5    
3    4    5", header=FALSE)

解决方案：其中一些步骤是清理输出

df %>%
  gather() %>%                   # wide-to-long format
  group_by(key) %>%              
  mutate(rn = row_number()) %>%  # add unique row_id per `key` group
  mutate(newval = 1) %>%         # fill in `existing` with this value
  ungroup() %>%                  # ungroup and unselect `key` group
  select(-key) %>%
  spread(value, newval, fill=0) %>%  # long-to-wide format
                                     # fill in `non-existing` with `0`
  select(-rn) %>%                    # unselect row_id column
  rename_all(funs(paste0("a", .)))   # rename columns

输出

# A tibble: 7 x 5
     a1    a2    a3    a4    a5
* <dbl> <dbl> <dbl> <dbl> <dbl>
1     1     1     1     0     0
2     1     1     0     0     1
3     1     0     1     1     0
4     1     0     1     0     1
5     1     0     0     1     1
6     0     1     1     0     1
7     0     0     1     1     1