R 多对矩阵之间的相似性/距离

我想通过计算每对中所有（多维）点集之间距离的平均值来量化组相似性

我可以很容易地为每对组手动执行此操作，如下所示：

library(dplyr)
library(tibble)
library(proxy)

# dummy data
set.seed(123)
df1 <- data.frame(x = rnorm(100,0,4), 
                  y = rnorm(100,1,5), 
                  z = rbinom(100, 1, 0.1))
df2 <- data.frame(x = rnorm(100,-1,3), 
                  y = rnorm(100,0,6), 
                  z = rbinom(100, 1, 0.1))
df3 <- data.frame(x = rnorm(100,-30,4), 
                  y = rnorm(100,10,2), 
                  z = rbinom(100, 1, 0.9))

# compute distance (unscaled, uncentred data)
dist(df1, df2, method = "gower") %>% mean
dist(df1, df3, method = "gower") %>% mean
dist(df2, df3, method = "gower") %>% mean

库（dplyr）
图书馆（tibble）
图书馆（代理）
#虚拟数据
种子集（123）
df1%平均值

但我想以某种方式将其矢量化，因为我的实际数据有30多个组。一个简单的for循环可以这样实现：

# combine data and scale, centre
df <- rbind(df1, df2, df3) %>% 
  mutate(id = rep(1:3, each = 100))
df <- df %>% 
  select(-id) %>%
  transmute_all(scale) %>% 
  add_column(id = df$id)

# create empty matrix for comparisons
n <- df$id %>% unique %>% length
m <- matrix(nrow = n, ncol = n)

# loop through each pair once
for(i in 1:n) {
  for(j in 1:i) { #omit top right corner
    if(i == j) {
      m[i,j] <- NA #omit diagonal
    } else {
      m[i,j] <- dist(df[df$id == i,1:3], df[df$id == j,1:3], method = "gower") %>% mean
    }
  }
}

m
          [,1]      [,2] [,3]
[1,]        NA        NA   NA
[2,] 0.2217443        NA   NA
[3,] 0.8446070 0.8233932   NA

#将数据和比例结合起来，居中
df%
变异（id=rep（1:3，每个=100））
df%
选择（-id）%%>%
转换所有（比例）%>%
添加列（id=df$id）
#为比较创建空矩阵
n%唯一%>%长度
我不确定这是否会很好，但这里有另一种方法。使用
ls
获取矩阵名称，
combn
生成两对，然后使用
get
获取矩阵以计算
dist

do.call(rbind,
        combn(ls(pattern = "df\\d+"), 2, FUN = function(x)
            data.frame(pair = toString(x),
                       dist = mean(dist(get(x[1]), get(x[2]), method = "gower")),
                       stringsAsFactors = FALSE),
            simplify = FALSE
        ))
#      pair      dist
#1 df1, df2 0.2139304
#2 df1, df3 0.8315169
#3 df2, df3 0.8320911

您可以将每对组连接起来，然后计算该组中的差异矩阵。显然，这意味着您在一定程度上比较了一个组和它本身，但它可能仍然适用于您的用例，并且使用
daisy
可以很快地确定数据的大小

library(cluster)

n <- 30
groups <- vector("list", 30)

# dummy data
set.seed(123)
for(i in 1:30) {
  groups[[i]] = data.frame(x = rnorm(1000,ceiling(runif(1, -10, 10)),ceiling(runif(1, 2, 4))), 
                           y = rnorm(1000,ceiling(runif(1, -10, 10)),ceiling(runif(1, 2, 4))), 
                           z = rbinom(1000,1,runif(1,0.1,0.9)))
}

m <- matrix(nrow = n, ncol = n)

# loop through each pair once
for(i in 1:n) {
  for(j in 1:i) { #omit top right corner
    if(i == j) {
      m[i,j] <- NA #omit diagonal
    } else {
      # concatenate groups
      dat <- rbind(df_list[[i]], df_list[[j]])

      # compute all distances (between groups and within groups), return matrix
      mm <- dat %>% 
        daisy(metric = "gower") %>%
        as.matrix

      # retain only distances between groups
      mm <- mm[(nrow(df_list[[i]])+1):nrow(dat) , 1:nrow(df_list[[i]])]

      # write mean distance to global comparison matrix
      m[i,j] <- mean(mm)
    }
  }
}

库（集群）
n
proxy
可以使用矩阵列表作为输入，
您只需要定义一个包装器函数，它可以完成您想要的：

nested_gower <- function(x, y, ...) {
  mean(proxy::dist(x, y, ..., method = "gower"))
}

proxy::pr_DB$set_entry(
  FUN = nested_gower,
  names = c("ngower"),
  distance = TRUE,
  loop = TRUE
)

df_list <- list(df1, df2, df3)
proxy::dist(df_list, df_list, method = "ngower")
     [,1]      [,2]      [,3]     
[1,] 0.1978306 0.2139304 0.8315169
[2,] 0.2139304 0.2245903 0.8320911
[3,] 0.8315169 0.8320911 0.2139049

但是，返回的值似乎会根据传递给函数的记录数量而变化，
所以很难说什么是最好的方法

*如果要在
代理中重新定义函数，请首先使用
proxy:：pr\u DB$delete\u entry（“ngower”）


如果您更喜欢代理的Gower交叉距离矩阵版本，
我突然想到，您可以利用my
dtwclust
软件包的一些功能并行进行计算：

library(dtwclust)
library(doParallel)

custom_dist <- new("tsclustFamily", dist = "ngower", control = list(symmetric = TRUE))@dist

workers <- makeCluster(detectCores())
registerDoParallel(workers)

distmat <- custom_dist(df_list)

stopCluster(workers); registerDoSEQ()

库（dtwclust）
图书馆（双平行）
custom_dist感谢@d.b.的回复。不幸的是，这并没有更快；使用上面的示例，组大小为500，在我的机器上需要32.16秒，而for循环需要32.84秒。@jogall，看起来最耗时的步骤是
dist
。除非有其他软件包能够更快地实现该
dist
，否则可能没有多少方法可以提高速度。是的，似乎是这样——我想我希望有人能够提出一种概念上不同的方法来解决这个问题，例如，可以使用某种有效的快捷方式来计算组平均值，而不是计算集合中每对向量之间的距离。@jogall，请查看
gower:：gower\u dist（）
。它似乎更快，但给出了不同的值；对于3个有1000行的组，你的方法需要2.4s，而我的方法需要146.5s——尽管它也在组距离内计算。我只想在你的代码中添加一点，说明如何在计算平均值之前只保留组间距离，因为我在这里感兴趣。感谢@Alexis的详细响应，我不知道你可以用
proxy
定义包装函数，所以这真的很有用。然而，我接受了@Thom的答案（稍加修改），原因很简单，因为它要快得多，而且总的计算时间是我面临的最大障碍——对于3组样本，每组1000行，这个方法需要2.4s对89.4s。@你仍然可以将建议的过程嵌入
daisy
中
nested\u gower
并让
proxy
执行循环。
library(dtwclust)
library(doParallel)

custom_dist <- new("tsclustFamily", dist = "ngower", control = list(symmetric = TRUE))@dist

workers <- makeCluster(detectCores())
registerDoParallel(workers)

distmat <- custom_dist(df_list)

stopCluster(workers); registerDoSEQ()