如何获得矩阵中两列值之间的绝对差
How to get the absolute difference between values in two columns in a matrix
我有一个如下所示的矩阵
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)
我通过编写一堆充满 for 循环的代码（65 行）来解决这个问题，很难阅读和编辑。
所以我想知道是否有另一种更有效的方法来做类似的事情，通过使用更紧凑的函数。
受到之前 post 的启发，它的答案非常简单（通过使用 aggregate() 函数）并通过在线搜索这些函数，我在这里尝试使用 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 是在 post 之上给出的矩阵。在这里您可以看到一点不同，我将绝对值与一个名为 probability_distribution 的变量相乘，但这并不重要。我把它从最初的 post 中去掉（乘法）以使其更简单。
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)
这是 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)))
您可以尝试 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
想法是：
- 按行对
i 和 j 进行排序并粘贴到新列 id 中。
- 按
id 分组并添加出现次数 n
- 传播者
n
- 计算绝对差。
基础R：
Lte 说你的矩阵的名称是 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
假设输入是矩阵 m 将具有相同 i、j 或 j、i 的元素分组 value。每个这样的组中将有 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
我有一个如下所示的矩阵
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)
我通过编写一堆充满 for 循环的代码（65 行）来解决这个问题，很难阅读和编辑。
所以我想知道是否有另一种更有效的方法来做类似的事情，通过使用更紧凑的函数。
受到之前 post 的启发，它的答案非常简单（通过使用 aggregate() 函数）并通过在线搜索这些函数，我在这里尝试使用 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 是在 post 之上给出的矩阵。在这里您可以看到一点不同，我将绝对值与一个名为 probability_distribution 的变量相乘，但这并不重要。我把它从最初的 post 中去掉（乘法）以使其更简单。
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)
这是 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)))
您可以尝试 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
想法是：
- 按行对
i和j进行排序并粘贴到新列id中。 - 按
id分组并添加出现次数n - 传播者
n - 计算绝对差。
基础R：
Lte 说你的矩阵的名称是 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
假设输入是矩阵 m 将具有相同 i、j 或 j、i 的元素分组 value。每个这样的组中将有 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