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

1
votes

I have matrix

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

which is not symmetric initially

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

I need to melt it first

mm = melt(m)

and only after that I would like to replace lower triangle values

> 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

with upper triangle values

> 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

I tried

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

but the result

> 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

is not symmetric for these two values pairs

   Var1 Var2 value
4     4    1     4
13    1    4     3

   Var1 Var2 value
7     3    2     3
10    2    3     4

Is there a beautiful way to make the matrix after melt symmetric by copying upper triangle values into lower triangle values?

2
rmatrixmelt
Do you have to melt? See stackoverflow.com/questions/33026183/… or stackoverflow.com/questions/26166569/… or stackoverflow.com/questions/49066123/… – thelatemail
@thelatemail After melt I add more columns to the molten matrix. Then I make a ggplot on the matrix and use one column for tile color and another column for text inside the tiles. – Heikki

2 Answers

1
votes

Use the fact that Var2 (column index) for lower triangle will be smaller than the Var1 (row index).

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
votes

We could make this short and sweet if we exploit the fact that match yields unsorted values in contrast to %in%. We work with the upper.tri of the transposed m, rather than the lower.tri of m to avoid the sorting issue.

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

Test

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

Looks quite symmetric.

Data

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)