Как получить абсолютную разницу между значениями в двух столбцах матрицы

У меня есть матрица, подобная следующей

      i j value
 [1,] 3 6 0.194201129
 [2,] 3 5 0.164547043
 [3,] 3 4 0.107149279
 [4,] 4 3 0.004927017
 [5,] 3 1 0.080454448
 [6,] 1 2 0.003220612
 [7,] 2 6 0.162313646
 [8,] 3 3 0.114992628
 [9,] 4 1 0.015337253
[10,] 1 6 0.026550051
[11,] 3 2 0.057004116
[12,] 4 2 0.006441224
[13,] 4 5 0.025641026
[14,] 2 4 0.004885993
[15,] 1 1 0.036552785
[16,] 1 5 0.048249186
[17,] 1 4 0.006053565
[18,] 1 3 0.004970296

Как видите, для некоторых пар i, j существует обратная пара. Например, для i = 3, j = 1 есть пара с i = 1, j = 3.

Вот чего я хочу добиться.

Для каждой пары i, j нужно вычесть обратное значение и получить абсолютное значение вычитания. Для тех пар, у которых нет обратной пары, из них вычитается 0.

Вот несколько примеров:

Для i = 3, j = 5 обратной пары нет (i = 5, j = 3), поэтому расчет становится следующим:

abs(0.164547043 - 0)

Для i = 3, j = 1 в матрице есть обратная пара с i = 1, j = 3, поэтому расчет будет следующим:

abs(0.004970296 - 0.080454448)

Я подошел к этому, написав кучу кода (65 строк), полного циклов for, и его трудно читать и редактировать.

Поэтому мне было интересно, есть ли другой более эффективный способ сделать что-то подобное, используя более компактные функции.

Мотивированный предыдущим сообщением, где его ответ был довольно простым (с использованием функции агрегата()) и поиском этих функций в Интернете, я пытаюсь использовать здесь mapply(), но правда в том, что я не могу справиться с обратным пары.

РЕДАКТИРОВАТЬ:

dput()
    memMatrix <- structure(c(3, 3, 3, 4, 3, 1, 2, 3, 4, 1, 3, 4, 4, 2, 1, 1, 1, 
        1, 6, 5, 4, 3, 1, 2, 6, 3, 1, 6, 2, 2, 5, 4, 1, 5, 4, 3, 0.194201128983738, 
        0.164547043451226, 0.107149278958536, 0.00492701677834917, 0.0804544476798398, 
        0.00322061191626409, 0.162313646044361, 0.114992627755601, 0.0153372534398016, 
        0.0265500506171091, 0.0570041160347523, 0.00644122383252818, 
        0.0256410256410256, 0.00488599348534202, 0.0365527853282693, 
        0.0482491856677524, 0.0060535654765406, 0.00497029586494912), .Dim = c(18L, 
        3L), .Dimnames = list(NULL, c("i", "j", "value")))

Также вот код, который пока работает, но он намного сложнее

Где memMatrix — матрица, приведенная вверху поста. И здесь вы можете увидеть небольшую разницу в том, что я умножаю абсолютное значение на переменную с именем probability_distribution, но это не имеет большого значения. Я удалил это (умножение) из исходного поста, чтобы сделать его более простым.

subFunc <- function( memMatrix , probability_distribution )
{

  # Node specific edge relevance matrix
  node_edgeRelm <- matrix(ncol = 3)
  colnames(node_edgeRelm) <- c("i","j","rel")
  node_edgeRelm <- na.omit(node_edgeRelm)

  for ( row in 1:nrow( memMatrix ) )
  {
    pair_i <- memMatrix[row,"i"]
    pair_j <- memMatrix[row,"j"]

    # If already this pair of i and j has been calculated continue with the next pair
    # At the end of a new calculation, we store the i,j (verse) values in order from lower to higher
    # and then we check here for the inverse j,i values (if exists).
    if( pair_i < pair_j )
      if( any(node_edgeRelm[,"i"] == pair_i & node_edgeRelm[,"j"] == pair_j) ) next
    if( pair_j < pair_i )
      if( any(node_edgeRelm[,"i"] == pair_j & node_edgeRelm[,"j"] == pair_i) ) next

    # Verse i,j
    mepm_ij <- as.numeric( memMatrix[which( memMatrix[,"i"] == pair_i & memMatrix[,"j"] == pair_j ), "mep"] )
    if( length(mepm_ij) == 0 )
      mepm_ij <- 0
    # Inverse j,i
    mepm_ji <- as.numeric( memMatrix[which( memMatrix[,"i"] == pair_j & memMatrix[,"j"] == pair_i ), "mep"] )
    if( length(mepm_ji) == 0 )
      mepm_ji <- 0

    # Calculate the edge relevance for that specific initial node x and pair i,j
    edge_relevance <- probability_distribution * abs( mepm_ij - mepm_ji )

    # Store that specific edge relevance with an order from lower to higher node
    if ( pair_i < pair_j)
      node_edgeRelm <- rbind( node_edgeRelm, c( as.numeric(pair_i), as.numeric(pair_j), as.numeric(edge_relevance) ) )
    else
      node_edgeRelm <- rbind( node_edgeRelm, c( as.numeric(pair_j), as.numeric(pair_i), as.numeric(edge_relevance) ) )
  }

  na.omit(node_edgeRelm)
}

вы можете запустить его как subFunc(memMatrix, 1/3)


person J. Doe    schedule 23.02.2018    source источник
comment
Пожалуйста, используйте dput, чтобы показать свои данные и поделиться своим кодом, даже если он не идеален.   -  person Tung    schedule 23.02.2018
comment
Спасибо, что упомянули об этом. Я просто редактирую пост.   -  person J. Doe    schedule 23.02.2018
comment
Размещенный код не воспроизводится, поскольку входные данные не предоставляются. См. минимально воспроизводимый пример.   -  person G. Grothendieck    schedule 23.02.2018
comment
Номер строки равен номеру столбца? Я не вижу i = 5, j = 3 в вашем примере.   -  person www    schedule 23.02.2018
comment
@www Нет. ncol не равно nrow. Что касается i = 5 , j = 3, я знаю, что его не существует, поэтому вычитание стало abs( 0.164547043 - 0 )   -  person J. Doe    schedule 23.02.2018


Ответы (4)


Предполагая, что входные данные представляют собой матрицу m, сгруппируйте value элементов теми, которые имеют одинаковые i, j или j, i. В каждой такой группе будет либо 1, либо 2 элемента value, поэтому для любой конкретной группы добавьте ноль к этому вектору длины 1 или 2 и возьмите первые 2 элемента, разность элементов результирующего вектора из 2 элементов и возьмите абсолютное значение. Эта процедура не изменяет порядок строк. Он дает фрейм данных, но при необходимости его можно преобразовать обратно в матрицу с помощью as.matrix. Пакеты не используются.

absdiff <- function(x) abs(diff(c(x, 0)[1:2]))
transform(m, value = ave(value, pmin(i, j), pmax(i, j), FUN = absdiff))

давая:

   i j       value
1  3 6 0.194201129
2  3 5 0.164547043
3  3 4 0.102222262
4  4 3 0.102222262
5  3 1 0.075484152
6  1 2 0.003220612
7  2 6 0.162313646
8  3 3 0.114992628
9  4 1 0.009283688
10 1 6 0.026550051
11 3 2 0.057004116
12 4 2 0.001555230
13 4 5 0.025641026
14 2 4 0.001555230
15 1 1 0.036552785
16 1 5 0.048249186
17 1 4 0.009283688
18 1 3 0.075484152
person G. Grothendieck    schedule 23.02.2018

Вот решение с library(purr), чтобы заставить match() работать со списками

library(purrr)

Создайте match, который работает со списками

match2 = as_mapper(match)

Создайте список, содержащий векторы длиной 2, содержащие два значения, затем второй список с перевернутыми значениями, затем сопоставьте два списка

i = match2(L <- map2(df[,1], df[,2], c),
                map(L, rev))

Извлечь третий столбец совпавших индексов

 v = df[i,3]

Замените NA/unmatched на 0, выполните вычитание, затем abs()

cbind(df, abs(df[,3]-replace(v, is.na(v), 0)))
person Vlo    schedule 23.02.2018
comment
Действительно, он возвращает ошибку, о которой упоминал Джимбоу. - person J. Doe; 23.02.2018
comment
@J.Doe Исправлено, я переопределил имена некоторых переменных перед публикацией. - person Vlo; 23.02.2018

Вы можете попробовать решение tidyverse:

library(tidyverse)
df %>% as.tibble() %>% 
  rowwise() %>% 
  mutate(id=paste(sort(c(i,j)), collapse = "_"))  %>% 
  group_by(id) %>% 
  mutate(n=paste0("n", 1:n())) %>% 
  select(-1,-2) %>% 
  spread(n, value, fill = 0) %>% 
  mutate(result=abs(n1-n2))
# A tibble: 14 x 4
# Groups:   id [14]
      id          n1          n2      result
   <chr>       <dbl>       <dbl>       <dbl>
 1   1_1 0.036552785 0.000000000 0.036552785
 2   1_2 0.003220612 0.000000000 0.003220612
 3   1_3 0.080454448 0.004970296 0.075484152
 4   1_4 0.015337253 0.006053565 0.009283688
 5   1_5 0.048249186 0.000000000 0.048249186
 6   1_6 0.026550051 0.000000000 0.026550051
 7   2_3 0.057004116 0.000000000 0.057004116
 8   2_4 0.006441224 0.004885993 0.001555230
 9   2_6 0.162313646 0.000000000 0.162313646
10   3_3 0.114992628 0.000000000 0.114992628
11   3_4 0.107149279 0.004927017 0.102222262
12   3_5 0.164547043 0.000000000 0.164547043
13   3_6 0.194201129 0.000000000 0.194201129
14   4_5 0.025641026 0.000000000 0.025641026

Идея такова:

  1. Отсортируйте построчно i и j и вставьте вместе в новый столбец id.
  2. Сгруппировать по id и добавить количество вхождений n
  3. Распространение от n
  4. вычислить абсолютную разницу.
person Roman    schedule 23.02.2018

База R: скажем, имя вашей матрицы mat

> B=matrix(0,max(mat[,1:2]),max(mat[,1:2]))
> B[mat[,1:2]]=mat[,3]
> A=cbind(which(upper.tri(B,T),T),abs(`diag<-`(B,0)[upper.tri(B,T)]-t(B)[upper.tri(B,T)]))
> A[A[,3]>0,]
      row col            
 [1,]   1   1 0.036552785
 [2,]   1   2 0.003220612
 [3,]   1   3 0.075484152
 [4,]   2   3 0.057004116
 [5,]   3   3 0.114992628
 [6,]   1   4 0.009283688
 [7,]   2   4 0.001555230
 [8,]   3   4 0.102222262
 [9,]   1   5 0.048249186
[10,]   3   5 0.164547043
[11,]   4   5 0.025641026
[12,]   1   6 0.026550051
[13,]   2   6 0.162313646
[14,]   3   6 0.194201129
person Onyambu    schedule 23.02.2018