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

时间:2019-04-03 22:26:07

标签: r matrix melt

我有矩阵

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之后的矩阵对称?

2 个答案:

答案 0 :(得分: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

答案 1 :(得分:1)

如果我们利用match产生与%in%相反的未排序值这一事实,我们可以做得简短而有趣。我们使用转置后的upper.tri的{​​{1}},而不是m的{​​{1}},以避免排序问题。

lower.tri

测试

m

看起来很对称。


数据

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