将 2d 矩阵与 3d 数组相乘以获得组件分数的 4d 数组

Multiply 2d matrix with 3d array to get 4d array for component scores

我有一个包含 4 人 x 3 个旋转组件的矩阵 seloas,以及一个包含 5 项 x 5 项 x(相同)4 人的数组 serawseraw 是原始(ish)共现计数,seloas 是基于 seraw 来自 PCA 的(旋转)加载。 seraw 的切片(= 矩阵)是对称的(因为共现计数)。

seloas <- structure(c(-0.232535340320219, -0.230627299973683, 0.124356407389266, 
-0.0203386851625857, -0.12959177205967, -0.0872107254451076, 
0.349621793484575, -0.081476095636832, -0.180898736708137, -0.0310458270134685, 
0.115458426682197, -0.472159305850741), .Dim = c(4L, 3L), .Dimnames = list(
c("Willy", "Karen", "Kristina", "Stefan"), c("PC1", "PC2", 
"PC3")))

seraw <- structure(c(1, 0, 0, 0, 0, 0, 1, 0, 0.2, 0.2, 0, 0, 1, 0, 0.2, 
0, 0.2, 0, 1, 0.4, 0, 0.2, 0.2, 0.4, 1, 1, 0, 0, 0, 0, 0, 1, 
0, 0, 0.0625, 0, 0, 1, 0, 0.0625, 0, 0, 0, 1, 0, 0, 0.0625, 0.0625, 
0, 1, 1, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 1, 0.166666666666667, 
0, 0, 0, 0.166666666666667, 1, 0, 0, 0, 0, 0, 1, 1, 0, 0, 0, 
0, 0, 1, 0, 0.111111111111111, 0, 0, 0, 1, 0.111111111111111, 
0.111111111111111, 0, 0.111111111111111, 0.111111111111111, 1, 
0, 0, 0, 0.111111111111111, 0, 1), .Dim = c(5L, 5L, 4L), .Dimnames = structure(list(
items = c("but-how", "encyclopedia", "alien", "language-of-bees", 
"bad-hen"), items = c("but-how", "encyclopedia", "alien", 
"language-of-bees", "bad-hen"), people = c("Willy", "Karen", 
"Kristina", "Stefan")), .Names = c("items", "items", "people"
)))

我有一个包含 4 人 x 3 个旋转组件的矩阵 seloas,以及一个包含 5 项 x 5 项 x(相同)4 人的数组 serawseraw 是原始(ish)共现计数,seloas 是基于 seraw 来自 PCA 的(旋转)加载。 seraw 的切片(= 矩阵)是对称的(因为共现计数)。

我现在想将组件负载与数组切片的 each 相乘,以便我得到一个新的 4d 数组 5项目 x 5 项目 x 4 人 x 3 旋转组件。 来自 seloas 的分量向量的每个人元素将乘以该人的相应数组切片 seraw。 每个单元格都是某些项目针对某些人针对每个组件的某些项目的原始分数。 为了进一步说明,我想

# res["encyclopedia", "language-of-bees", "Willy", "PC1"] ==
seloas["Willy", "PC1"] * seraw["encyclopedia", "language-of-bees", "Willy"]

为了将分量分数作为加载加权平均值,然后我可以 apply() 我想绕过 4d 数组,我想保持原样 [=40] =] 用于其他汇总计算。

有没有有效的matrix-/tensor-algebraic方法来完成这个?

这是为了澄清我目前不清楚的内容。这是期望的目标吗? (请注意,如果原理组件的数量为3,我无法弄清楚为什么第四维应该是4)

res <- array(NA, c(5,5,4,3) )
dimnames(res)[[4]] <-c("PC1", "PC2" ,"PC3")
dimnames(res)[[3]] <-c("Willy", "Karen", "Kristina", "Stefan")
for( sub in c("Willy", "Karen", "Kristina", "Stefan") ) {
 for ( pc in c("PC1", "PC2" ,"PC3") ){
 res[ , ,sub, pc] <- seloas[sub, pc] * seraw[ , , sub] }}
 res[ , , "Willy", 1:2]
#---------
, , PC1

           [,1]        [,2]        [,3]        [,4]        [,5]
[1,] -0.2325353  0.00000000  0.00000000  0.00000000  0.00000000
[2,]  0.0000000 -0.23253534  0.00000000 -0.04650707 -0.04650707
[3,]  0.0000000  0.00000000 -0.23253534  0.00000000 -0.04650707
[4,]  0.0000000 -0.04650707  0.00000000 -0.23253534 -0.09301414
[5,]  0.0000000 -0.04650707 -0.04650707 -0.09301414 -0.23253534

, , PC2

           [,1]        [,2]        [,3]        [,4]        [,5]
[1,] -0.1295918  0.00000000  0.00000000  0.00000000  0.00000000
[2,]  0.0000000 -0.12959177  0.00000000 -0.02591835 -0.02591835
[3,]  0.0000000  0.00000000 -0.12959177  0.00000000 -0.02591835
[4,]  0.0000000 -0.02591835  0.00000000 -0.12959177 -0.05183671
[5,]  0.0000000 -0.02591835 -0.02591835 -0.05183671 -0.12959177

我认为您可以 select 以这种方式构建的 kronecker 叉积的某些切片:

 kres <- kronecker(seloas , seraw , make.dimnames=TRUE) 

请注意 "Willy:PC1" 项与 res[ , , "Willy", "PC1"] 值

相同
> kres[ 1:5, 1:5, 1]
                       PC1:but-how PC1:encyclopedia   PC1:alien PC1:language-of-bees
Willy:but-how           -0.2325353       0.00000000  0.00000000           0.00000000
Willy:encyclopedia       0.0000000      -0.23253534  0.00000000          -0.04650707
Willy:alien              0.0000000       0.00000000 -0.23253534           0.00000000
Willy:language-of-bees   0.0000000      -0.04650707  0.00000000          -0.23253534
Willy:bad-hen            0.0000000      -0.04650707 -0.04650707          -0.09301414
                       PC1:bad-hen
Willy:but-how           0.00000000
Willy:encyclopedia     -0.04650707
Willy:alien            -0.04650707
Willy:language-of-bees -0.09301414
Willy:bad-hen          -0.23253534
> res[, ,"Willy", "PC1"]
           [,1]        [,2]        [,3]        [,4]        [,5]
[1,] -0.2325353  0.00000000  0.00000000  0.00000000  0.00000000
[2,]  0.0000000 -0.23253534  0.00000000 -0.04650707 -0.04650707
[3,]  0.0000000  0.00000000 -0.23253534  0.00000000 -0.04650707
[4,]  0.0000000 -0.04650707  0.00000000 -0.23253534 -0.09301414
[5,]  0.0000000 -0.04650707 -0.04650707 -0.09301414 -0.23253534

并非叉积中的所有项目都有用,但如果您想使用 kronecker:

,这将是 "index"
> attributes(kronecker(seloas , seraw , make.dimnames=TRUE) )
$dim
[1] 20 15  4

$dimnames
$dimnames[[1]]
 [1] "Willy:but-how"             "Willy:encyclopedia"        "Willy:alien"              
 [4] "Willy:language-of-bees"    "Willy:bad-hen"             "Karen:but-how"            
 [7] "Karen:encyclopedia"        "Karen:alien"               "Karen:language-of-bees"   
[10] "Karen:bad-hen"             "Kristina:but-how"          "Kristina:encyclopedia"    
[13] "Kristina:alien"            "Kristina:language-of-bees" "Kristina:bad-hen"         
[16] "Stefan:but-how"            "Stefan:encyclopedia"       "Stefan:alien"             
[19] "Stefan:language-of-bees"   "Stefan:bad-hen"           

$dimnames[[2]]
 [1] "PC1:but-how"          "PC1:encyclopedia"     "PC1:alien"           
 [4] "PC1:language-of-bees" "PC1:bad-hen"          "PC2:but-how"         
 [7] "PC2:encyclopedia"     "PC2:alien"            "PC2:language-of-bees"
[10] "PC2:bad-hen"          "PC3:but-how"          "PC3:encyclopedia"    
[13] "PC3:alien"            "PC3:language-of-bees" "PC3:bad-hen"         

$dimnames[[3]]
[1] ":Willy"    ":Karen"    ":Kristina" ":Stefan"