I have a matrix seloas of 4 people x 3 rotated components, and an array seraw of 5 items x 5 items x (the same) 4 people.
seraw are raw(ish) co-occurence counts, and seloas are (rotated) loadings from a PCA based on that seraw.
The slices (= matrices) of seraw are symmetrical (beacuse co-occurence counts).
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"
)))
I have a matrix seloas of 4 people x 3 rotated components, and an array seraw of 5 items x 5 items x (the same) 4 people.
seraw are raw(ish) co-occurence counts, and seloas are (rotated) loadings from a PCA based on that seraw.
The slices (= matrices) of seraw are symmetrical (beacuse co-occurence counts).
I now want to multiply the component loadings with each of the array slices, so that I get a new 4d array of 5 items x 5 items x 4 people x 3 rotated components.
Each person-element of the component vectors from seloas would be multiplied by the respective array slice seraw for that person.
Each cell would be the raw score of some item against some item against for some person for each of the components.
To further illustrate, I'd like
# res["encyclopedia", "language-of-bees", "Willy", "PC1"] ==
seloas["Willy", "PC1"] * seraw["encyclopedia", "language-of-bees", "Willy"]
To get the component scores as the loadings-weighted averages, I can then apply() my way around the 4d array, which I'd like to keep around as is for other summary calculations.
Is there an efficient matrix-/tensor-algebraic way of accomplishing this?
This is an effort to clarify what Is unclear to me at the moment. Is this the desired goal? (Note that I could not figure out why the fourth dimension should be 4 if the number of principla compoents was 3)
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
I think that you can select certain slices from the kronecker cross-product that is built this way:
kres <- kronecker(seloas , seraw , make.dimnames=TRUE)
Notice that the "Willy:PC1" items is the same as res[ , , "Willy", "PC1"] values
> 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
Not all of the items in the cross-product would be useful but this would be the "index" if you wnated to use 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"