Принуждение значений верхнего треугольника к значениям нижнего треугольника в матрице после расплава - PullRequest
Новая
       16

Принуждение значений верхнего треугольника к значениям нижнего треугольника в матрице после расплава

1 голос
/ 04 апреля 2019

У меня есть матрица 

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 ]

1 голос
/ 04 апреля 2019

Мы могли бы сделать это коротким и приятным, если бы использовали тот факт, что match дает несортированные значения в отличие от %in%.Мы работаем с upper.tri транспонированного m, а не с lower.tri из m, чтобы избежать проблемы сортировки. 

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

Выглядит довольно симметрично.

Данные 

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)
1 голос
/ 04 апреля 2019

Используйте тот факт, что 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
...