r - R：计算数据帧的逐行相似度并根据该相似度对数据进行排序

Question

大家好，对不起，但我对行明智的相似性比较有一个心理问题。我有一个数百次运行的聚类结果表。他们看起来像这样

第一列是样本 ID，然后每次运行我要求 Kmeans 给我 8 个集群，每次运行有 10% 的样本丢失用于稳定性测试。

因为每次运行都是独立的，所以run_0中的cluster 1不等于run_1中的cluster 1，这些数字是随机分配的。

我想计算每个样本行的相似性，即我想知道在这数百次运行中哪些样本大部分时间都在一起。

我看过这篇文章，这几乎是我想要的

如何计算R中表中所有行的相似度？

但是，我只是不太了解该功能。

row_cf <- function(x, y, df){
  sum(df[x,] == df[y,])/ncol(df)
}

你们能否向我解释一下这个功能。我不明白为什么 (df[x,] == df[y,])/ncol(df)) 的总和可以代表 X 行和 Y 行之间的相似性。这是在问 X 行中有多少列相等到第y行，然后将它们相加并给我相似列的比例？

如果是这种情况，那么将所有 NA 分配给像 9 这样的固定值会增加相似度，对吧？

逐对计算行相似性百分比并将其添加为新列

我看过这篇文章，输出有点像我想要的。我的最终目标是在第一列输出患者样本 ID 来表示整个数据，第二列将是最相似样本的患者样本 ID ，第三列是相似度得分。

如果需要，可以使用虚拟数据

Sample <- LETTERS[seq( from = 1, to = 20 )]
run_1 <- rep(1:4, each=5)
run_2 <- c(rep(1:2, each=4),rep(3:4,6))
run_3 <- rep(4:1, each=5)
run_4 <- c(rep(4:3, each=4),rep(1:2,6))

df <- data.frame(cbind(Sample, run_1,run_2,run_3,run_4))


#switch off row names
df1 <- df %>% remove_rownames() %>%
  column_to_rownames(var="patient_sample")


#replace NA to some value outside the cluster ID range

df1[is.na(df1)] <- 10



# define a similary funciton

 row_cf <- function(x, y, df){
   sum(df[x,]==df[y,])/ncol(df)
 }


#calculate the similarity

Sim <- expand.grid(1:nrow(df1), 1:nrow(df1)) %>%
  rename(row_1 = Var1, row_2 = Var2) %>%
  rowwise() %>%
  mutate(similarity = row_cf(row_1, row_2, df1)) %>%
  filter(row_1 != row_2) %>%
  group_by(row_1) %>%
  slice(which.max(similarity))

 #join to known data table

 df1 %>% mutate(row_1 = 1:n()) %>%
   left_join(Sim)

这是我修改后的尝试，但并没有完全完成这项工作。如果我使用连接表，我仍然会丢失行名。

我的想法是有

    Row_1   Row_2  Similarity

    A        C       90%
    B        E       90%
    C        J       88%
    D        N       80%
    E        Y       70%
    F        G       60%

我想保留ID的原因是最终我想像上面的帖子一样看看哪些样本最相似，但我也想根据相似度将它们分类为8个集群，从而实现最终稳定的8个集群样品。我怎样才能解决这个细分？运行层次聚类？

标签： rcluster-analysissimilarity

Answer 1

我认为NA用代码替换 s 不是一个好主意，因为那会假设所有NAs 都是相同的，我认为这不合适。您选择的相似性指标很好，但由于它是对称的，我们可以避免一半的比较。

示例数据

set.seed(1)

Sample <- LETTERS[1:18]
r <- sort(rep(1:6, 3))

df <- replicate(20, {
    ix <- sample(1:length(r), 7)
    r[ix] <- sample(r[ix], 7, rep=TRUE)
    r
})

df[sample(1:length(df), 40)] <- NA
df <- cbind(Sample, data.frame(df), stringsAsFactors=FALSE)

计算成对汉明距离

pair <- t(combn(1:nrow(df), 2))
similarity <- numeric(nrow(pair))
id <- matrix("", nrow(pair), 2)

m <- matrix(NA, nrow(df), nrow(df))
dimnames(m) <- list(df[,1], df[,1])

hamming <- function(a, b) {
    sum(a == b, na.rm=TRUE)/length(a)
}

for (i in 1:nrow(pair)) {
    r <- pair[i,]
    similarity[i] <- hamming(df[r[1], -1], df[r[2], -1]) 
    id[i, ] <- df[r, 1]
    m[id[i, , drop=FALSE]] <- similarity[i]
}

out <- data.frame(id, similarity, stringsAsFactors=FALSE)
out <- out[order(similarity, decreasing=TRUE), ]
rownames(out) <- NULL

head(out)
#   X1 X2 similarity
# 1  B  C       0.60
# 2  A  B       0.50
# 3  M  N       0.45
# 4  P  R       0.45
# 5  A  C       0.40
# 6  G  H       0.40

kmeans(as.dist(t(m)), 4)$cluster
# A B C D E F G H I J K L M N O P Q R 
# 1 1 1 2 2 2 2 4 2 2 2 2 4 4 4 3 3 3 

plot(hclust(1-as.dist(t(m))))