R:计算数据框的逐行相似度并根据该相似度对数据进行排序

R: Compute the row-wise similarity for a dataframe and sort data out based on that similarity

大家好,抱歉,我对行明智的相似性比较有一个心理结。 我在几百 运行 秒内得到了 table 的聚类结果。他们看起来像这样

第一列是样本 ID,然后每个 运行 我要求 Kmeans 给我 8 个簇,每个 运行 有 10% 的样本脱落用于稳定性测试。

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

我想计算每个样本行的相似度,也就是说,我想知道在这数百 运行 中,哪些样本大部分时间都在一起。

我看到了这个post 几乎就是我想要的

但是,我只是不太明白这个功能。

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会增加相似度吧?

我看过这个 post,输出有点像我 want.My 最终目标是输出第一列中的患者样本 ID 代表整个数据,第二列将是最相似样本的患者样本 ID,第 3 列是相似度得分。

如果你需要虚拟数据

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)

这是我修改过的尝试,但它并没有完全完成工作。如果我使用联接 table,我仍然会丢失行名称。

我的想法是

    Row_1   Row_2  Similarity

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

我想保留 ID 的原因是最终我想看看哪些样本与上面的 post 最相似,但我也想根据相似性将它们分成 8 个簇,这样就实现了最终的stable 8个样本簇。我该如何解决这个细分问题? 运行 层次聚类?

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

示例数据

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))))