遍历R中的矩阵并计算所有用户之间的测量差异

Question

我有一个 10 行乘 4 列的矩阵。每行代表一个用户，每列代表一个测量值。有些用户只有一个测量值，而其他用户可能有完整的 4 个测量值。

我想用这个矩阵实现三个目标：

1. 从用户自己的测量值中减去用户的测量值（跨列）；
2. 从其他用户的测量点中减去用户的测量值（全部包括在内，跨行）；
3. 创建一个最终矩阵，计算每个用户与自己和他人的“匹配”（比较）数量。

在 2.0 个单位的阈值内，我尝试通过使用嵌套 for 循环获得差异来衡量每个用户的测量值与他们自己和其他用户的测量值。

以下是clean_data 矩阵的示例，该矩阵用于所有三个目标：

        M1      M2      M3      M4       
  U1    148.2   148.4   155.6   155.7
  U2    149.5   150.1   150.1   153.9
  U3    148.4   154.2   NA      NA
  U4    154.5   NA      NA      NA         
  U5    151.1   156.9   157.1   NA         
  

对于目标 #3，输出 应该类似于以下矩阵：

        U1    U2    U3    U4    U5
   U1   2     8     4     2     3
   U2   8     3     2     1     4
   U3   4     2     0     1     0
   U4   2     1     1     0     0
   U5   3     4     0     0     1

例如：用户 1 与自己有 2 个匹配项，因为在他们的所有 4 次测量中，有 2 个差异小于 2.0 个单位的值。用户 1 还与 用户 2 有 8 个匹配项。用户 1 的每个测量值都从用户 2 的测量值中迭代地减去（存储为绝对值），低于 2 的差值被视为“匹配”。

我曾尝试使用以下嵌套的 for 循环，但我相信它只是计算矩阵中元素的数量，而不是添加差异。

# Set the time_threshold.

time_threshold <- 2.000

# Create an empty matrix the same dimensions as the number of users present.
matrix_a<-matrix(nrow = nrow(clean_data), ncol = nrow(clean_data))

# Use a nested for-loop to calculate the intra-user 
# and inter-user time differences, adding values below 
# the threshold up for those user-comparisons.

for (i in 1:nrow(clean_data)) {
  for (j in 1:nrow(clean_data)) {
    matrix_a[i, j] <-
      round(sum(!is.na(abs((clean_data[i, 2:dim(clean_data)[2]]) -
                             (clean_data[j, 2:dim(clean_data)[2]])
      ) <= time_threshold)) / 2)
  }
}
 
# Dividing by 2 and rounding has proven that this code only counts the 
# number of vectors that are not NA, not the values below by time_threshold (2.000).

有没有一种方法可以计算我上面概述的差异，并且比嵌套的 for 循环更有效？

注意： 这些数据的结构仅在可以计算跨行和跨列的个体差异时才有意义。此示例中的缺失值表示为 NA，并且应该不包含在计算中。或者，我将它们设置为 -0.01，这仍然没有改变我的 for 循环的结果。

Answer 1

您可以编写一个函数来为您执行循环：

fun <- function(index, dat){
  i <- index[1]
  j <- index[2]
  m <- if(i==j) combn(dat[i,],2, function(x)diff(x))
   else do.call("-", expand.grid(dat[i, ], dat[j, ]))
  sum(abs(m)<2, na.rm = TRUE)
}

dist_fun <- function(dat){
  dat <- as.matrix(dat)
  result <- diag(0, nrow(dat))
  mat_index <- which(lower.tri(result, TRUE), TRUE)
  result[mat_index] <- apply(mat_index, 1, fun, dat = dat)
  result[mat_index[,2:1]] <- result[mat_index]
  result
}

dist_fun(df)
     [,1] [,2] [,3] [,4] [,5]
[1,]    2    8    4    2    4
[2,]    8    3    4    1    3
[3,]    4    4    0    1    0
[4,]    2    1    1    0    0
[5,]    4    3    0    0    1

Answer 2

这是一种 tidyverse 方法。我将数据转换为更长的格式，然后通过用户（跨）和时间点（向下）将其连接到自身，每次计算匹配数。然后我将两者结合起来再次转换为宽格式。

library(tidyverse)
my_data2 <- my_data %>% pivot_longer(-User)

left_join(my_data2, my_data2, by = "User") %>%
  filter(name.x < name.y, abs(value.y - value.x) <= 2) %>%   # EDIT
  count(User) %>%
  select(User.x = User, User.y = User, n) -> compare_across

my_data3 <- my_data2 %>% mutate(dummy = 1)                   # EDIT
inner_join(my_data3, my_data3, by = "dummy") %>%             # EDIT
  filter(abs(value.x - value.y) <=2, User.x != User.y) %>%
  count(User.x, User.y) -> compare_down

bind_rows(compare_across, compare_down) %>%
  arrange(User.x, User.y) %>%
  pivot_wider(names_from = User.y, values_from = n, values_fill = list(n = 0))


# A tibble: 5 x 6
  User.x    U1    U2    U3    U4    U5
  <chr>  <int> <int> <int> <int> <int>
1 U1         2     8     4     2     4
2 U2         8     3     4     1     3
3 U3         4     4     0     1     0
4 U4         2     1     1     0     0
5 U5         4     3     0     0     1

---

源数据：

my_data <- data.frame(
  stringsAsFactors = FALSE,
              User = c("U1", "U2", "U3", "U4", "U5"),
                M1 = c(148.2, 149.5, 148.4, 154.5, 151.1),
                M2 = c(148.4, 150.1, 154.2, NA, 156.9),
                M3 = c(155.6, 150.1, NA, NA, 157.1),
                M4 = c(155.7, 153.9, NA, NA, NA)
)