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

Loop through matrix in R and calculate measurement difference between all users

我有一个 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 循环的结果。

这是一种 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)
)

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

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