检查值是否在矩阵中，然后填充模板矩阵

Question

我不知道有什么其他的好方法来表达标题。

我对给定的矩阵进行了热编码。例如here

> set.seed(4)
> t <- matrix(floor(runif(10, 1,9)),5,5)

      [,1] [,2] [,3] [,4] [,5]
[1,]    5    3    5    3    5
[2,]    1    6    1    6    1
[3,]    3    8    3    8    3
[4,]    3    8    3    8    3
[5,]    7    1    7    1    7
> class(t)
[1] "matrix"

      1_1 1_3 1_5 1_7 2_1 2_3 2_6 2_8 3_1 3_3 3_5 3_7 4_1 4_3 4_6 4_8 5_1 5_3 5_5 5_7
[1,]   0   0   1   0   0   1   0   0   0   0   1   0   0   1   0   0   0   0   1   0
[2,]   1   0   0   0   0   0   1   0   1   0   0   0   0   0   1   0   1   0   0   0
[3,]   0   1   0   0   0   0   0   1   0   1   0   0   0   0   0   1   0   1   0   0
[4,]   0   1   0   0   0   0   0   1   0   1   0   0   0   0   0   1   0   1   0   0
[5,]   0   0   0   1   1   0   0   0   0   0   0   1   1   0   0   0   0   0   0   1

我一直在努力转换另一个矩阵，例如如下所示以转换为预期的形式。

     [,1] [,2] [,3] [,4] [,5]
[1,]    7    4    8    1    3
[2,]    3    7    4    8    1
[3,]    1    3    7    4    8
[4,]    8    1    3    7    4

预期以下情况，其中列保持为先前的编码矩阵，但需要根据新给定矩阵中的值用0s 和1s 填充列。

      1_1 1_3 1_5  1_7 2_1 2_3 2_6 2_8 3_1 3_3 3_5 3_7 4_1 4_3 4_6 4_8 5_1 5_3 5_5 5_7
[1,]   0   0   0    1   0   0   0   0   0   0   0   0   1   0   0   0   0   1   0   0
[2,]   0   1   0    0   0   0   0   0   0   0   0   0   0   0   0   1   1   0   0   0 
[3,]   1   0   0    0   0   1   0   0   0   0   0   1   0   0   0   0   0   0   0   0
[4,]   0   0   0    0   1   0   0   0   0   1   0   0   0   0   0   0   0   0   0   0

由于列名与新给定矩阵中的值不同，我不知道如何检查新给定列值与旧列值。

任何建议或提示都会大有帮助。我整个周末都在为此苦苦挣扎。

Answer 1

在这里，我们使用asplit 将't' 和'oldt' 逐列拆分，将MARGIN 指定为2，然后使用Map 将拆分数据集的相应list 元素与序列一起传递列 (seq_len(ncol(t)))。在Map内部，创建匿名函数调用（function(x, y, z) - x, y, z，分别代表't'、'oldt'的列值和列索引），创建sortedunique向量来自'oldt' 列值（'y1'），一个 0 的 matrix 用于存储输出（'m1'），然后是 sort 't' 和 'oldt' 列中通用的值（'v1 '), 获取该值在't' 列('i1') 中的行位置，以及通过matching 列名与pasteed 序列('z') 和' v1'，使用行/列索引，replace 矩阵中的那些位置 ('m1') 与 1。

do.call(cbind, Map(function(x, y, z) {
    y1 <- sort(unique(y))
    m1 <- matrix(0, length(x), length(y1), dimnames = list(NULL, paste(z, y1, sep="_")))
    v1 <- sort(intersect(x, y))
    i1 <- match(v1, x)
    j1 <- match(paste(z, v1, sep="_"), colnames(m1))
    replace(m1, cbind(i1, j1), 1) }, asplit(t, 2), asplit(oldt, 2), seq_len(ncol(t))))
#     1_1 1_3 1_5 1_7 2_1 2_3 2_6 2_8 3_1 3_3 3_5 3_7 4_1 4_3 4_6 4_8 5_1 5_3 5_5 5_7
#[1,]   0   0   0   1   0   0   0   0   0   0   0   0   1   0   0   0   0   1   0   0
#[2,]   0   1   0   0   0   0   0   0   0   0   0   0   0   0   0   1   1   0   0   0
#[3,]   1   0   0   0   0   1   0   0   0   0   0   1   0   0   0   0   0   0   0   0
#[4,]   0   0   0   0   1   0   0   0   0   1   0   0   0   0   0   0   0   0   0   0

数据

oldt <- structure(c(5, 1, 3, 3, 7, 3, 6, 8, 8, 1, 5, 1, 3, 3, 7, 3, 6, 
8, 8, 1, 5, 1, 3, 3, 7), .Dim = c(5L, 5L))

t <- structure(c(7, 3, 1, 8, 4, 7, 3, 1, 8, 4, 7, 3, 1, 8, 4, 7, 3, 
1, 8, 4), .Dim = 4:5)