将带有3d数组的2d矩阵乘以得到4d数组以获得分量分数

时间:2016-08-16 18:27:35

标签: arrays r matrix pca

我有一个4人×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人×3个旋转组件的矩阵seloas,以及5个项目x 5个项目x(相同)4个人的数组serawseraw是原始(ish)共生计数,seloas是基于seraw来自PCA的(轮换)加载。 seraw的切片(=矩阵)是对称的(因为共生计数)。

我现在想要将组件加载与每个的数组切片相乘,这样我就得到一个新的 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数组,我希望将保留在中其他汇总计算。

是否有一种有效的矩阵/张量代数方法来实现这一目标?

1 个答案:

答案 0 :(得分:1)

这是为了澄清目前我不清楚的事情。这是预期的目标吗? (请注意,如果原则组件的数量是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

我认为您可以从以这种方式构建的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,这将是“索引”:

> 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"