熔化后将矩阵中的上三角值强制为下三角值

Question

我有矩阵

m = matrix(c(0,-1,-2,-3,1,0,-4,-5,2,4,0,-6,3,5,6,0),4,4)
m

最初不是对称的

     [,1] [,2] [,3] [,4]
[1,]    0    1    2    3
[2,]   -1    0    4    5
[3,]   -2   -4    0    6
[4,]   -3   -5   -6    0

我需要先melt它

mm = melt(m)

只有在那之后我想替换下三角值

> mm[melt(lower.tri(m))['value']==TRUE,]

   Var1 Var2 value
2     2    1    -1
3     3    1    -2
4     4    1    -3
7     3    2    -4
8     4    2    -5
12    4    3    -6

具有上三角值

> mm[melt(upper.tri(m))['value']==TRUE,]

   Var1 Var2 value
5     1    2     1
9     1    3     2
10    2    3     4
13    1    4     3
14    2    4     5
15    3    4     6

我试过了

mm[melt(lower.tri(m))['value']==TRUE,'value'] = mm[melt(upper.tri(m))['value']==TRUE,'value']

但结果

> mm
   Var1 Var2 value
1     1    1     0
2     2    1     1
3     3    1     2
4     4    1     4
5     1    2     1
6     2    2     0
7     3    2     3
8     4    2     5
9     1    3     2
10    2    3     4
11    3    3     0
12    4    3     6
13    1    4     3
14    2    4     5
15    3    4     6
16    4    4     0

这两个值对不对称

   Var1 Var2 value
4     4    1     4
13    1    4     3

   Var1 Var2 value
7     3    2     3
10    2    3     4

有没有一种漂亮的方法可以通过将上三角值复制到下三角值来使 melt 之后的矩阵对称？

Answer 1

使用下三角的 Var2（列索引）将小于 Var1（行索引）的事实。

mm$value2 = sapply(1:NROW(mm), function(i){
    if (mm$Var2[i] - mm$Var1[i] < 0){
        mm$value[i] = mm$value[mm$Var1 == mm$Var2[i] & mm$Var2 == mm$Var1[i]]
    }else{
        mm$value[i]
    }
})
mm
#   Var1 Var2 value value2
#1     1    1     0      0
#2     2    1    -1      1
#3     3    1    -2      2
#4     4    1    -3      3
#5     1    2     1      1
#6     2    2     0      0
#7     3    2    -4      4
#8     4    2    -5      5
#9     1    3     2      2
#10    2    3     4      4
#11    3    3     0      0
#12    4    3    -6      6
#13    1    4     3      3
#14    2    4     5      5
#15    3    4     6      6
#16    4    4     0      0

Answer 2

如果我们利用 match 与 %in% 相比产生未排序值这一事实，我们可以使这个简短而有趣。我们使用转置 m 的 upper.tri，而不是 m 的 lower.tri，以避免排序问题。

mm$value[match(t(m)[which(upper.tri(m))], mm$value)] <- m[which(upper.tri(t(m)))]

测试

dcast(mm, Var1 ~ Var2, value.var="value")[-1]
#   1 2 3 4
# 1 0 1 2 3
# 2 1 0 4 5
# 3 2 4 0 6
# 4 3 5 6 0

看起来很对称。

数据

m <- structure(c(0, -1, -2, -3, 1, 0, -4, -5, 2, 4, 0, -6, 3, 5, 6, 0), .Dim = c(4L, 4L))
mm <- data.table::melt(m)

熔化后将矩阵中的上三角值强制为下三角值

Forcing upper triangle values to lower triangle values in matrix after melt

r

matrix

melt