logo标签列表

计算相似度百分比或计算超过2个对象之间的相关性。

rmachine-learningstatistics
8

假设我有四个物体（a，b，c，d），我让五个人根据它们的外观或其他因素对它们进行分类（类别1或类别2）。这些物体的标签由五个人提供，如下所示：

df <- data.frame(a = c(1,2,1,2,1), b=c(1,2,2,1,1), c= c(2,1,2,2,2), d=c(1,2,1,2,1))

以表格形式展示，

 ---------
  a b c d
 ---------
  1 1 2 1
  2 2 1 2
  1 2 2 1
  2 1 2 2
  1 1 2 1
----------

现在我想计算一组对象被赋予相同标签（1或2）的次数的百分比。例如，a、b和d被5个人中的3个人赋予了相同的标签。因此，其百分比为3/5（=60%）。而a和d被所有人赋予相同的标签，所以它的百分比为5/5（=100%）。
我可以手动计算这个统计量，但在我的原始数据集中，有50个这样的对象，30个人和4个标签（1、2、3和4）。如何自动计算这个更大数据集的统计信息？是否有现成的R包/工具可以计算这样的统计量？
注：一个组的大小可以是任意的。在第一个例子中，一组由a、b和d组成，而在第二个例子中，一组由a和d组成。
6个回答
4
如果您有数字评分，您可以使用diff来检查每个评分者之间是否始终具有0差异：
f <- function(cols, data) {
  sum(colSums(diff(t(data[cols]))==0)==(length(cols)-1)) / nrow(data)
}

将函数应用于示例组时，结果如预期：

f(c("a","b","d"), df)
#[1] 0.6
f(c("a","d"), df)
#[1] 1
4
这里有两个任务：首先是列出所有相关组合，其次是对行相似性进行评估和聚合。 combn 可以开始第一个任务，但需要一些调整才能将结果排列成整洁的列表。第二个任务可以使用 prop.table 处理，但在这里直接计算更简单。
在这里，我使用了 tidyverse 语法（主要使用 purrr 来处理列表），但如果你愿意可以转换为基本语法。
library(tidyverse)

map(2:length(df), ~combn(names(df), .x, simplify = FALSE)) %>%    # get combinations
    flatten() %>%    # eliminate nesting
    set_names(map_chr(., paste0, collapse = '')) %>%    # add useful names
    # subset df with combination, see if each row has only one unique value
    map(~apply(df[.x], 1, function(x){n_distinct(x) == 1})) %>% 
    map_dbl(~sum(.x) / length(.x))    # calculate TRUE proportion

##   ab   ac   ad   bc   bd   cd  abc  abd  acd  bcd abcd 
##  0.6  0.2  1.0  0.2  0.6  0.2  0.0  0.6  0.2  0.0  0.0
当我在原始包含40个对象（变量）和10个观察值的数据帧上运行上述代码时，它永远不会停止。在开始之前，我有8GB的磁盘空间，但在运行期间，窗口弹出并显示警告“磁盘空间已满”，几分钟后我的系统挂起并崩溃。有没有更好的解决方案可以使其更快，占用更少的内存。它在崩溃之前运行了45分钟。 - Haroon Lone
是的，组合很快就会变得非常庞大。对于40个变量，这是sum(choose(40, 2:40)) = 1.099512e+12种组合，每种组合都有10个观测值。如果您愿意，可以轻松地一次计算一个子集，但更有用的可能是研究聚类方法。 - alistaire
我在corei7机器上使用R parallel包并行化了代码，然后在串行代码和并行代码中尝试了choose(40,5)。令我惊讶的是，并行化的代码比串行化的代码花费更多时间。你有什么想法吗？ - Haroon Lone
很大程度上取决于实现方式。并行化涉及更多计算（需要拆分和重组），以及更多内存（如果可用），因此速度不是确定的。然而，这些都是奖励更聪明的玩法而不是更努力的问题，具体取决于您要寻找什么。如果您只想要具有超过75％匹配的组合，则首先运行40个选择2，然后过滤包含高性能小组合的较大组合。更好的方法是使用实际的聚类算法，如 plot(hclust(dist(t(df), method = 'manhattan') / nrow(df)))。 - alistaire
2

使用基础R函数，您可以执行以下操作：

 groupVec = c("a","b","d")

 transDF = t(as.matrix(DF))

 subDF  = transDF[rownames(transDF) %in% groupVec,]
 subDF
   # [,1] [,2] [,3] [,4] [,5]
 # a    1    2    1    2    1
 # b    1    2    2    1    1
 # d    1    2    1    2    1

 #if length of unique values is 1, it implies match across all objects, count unique values/total columns = match pct
 match_pct = sum(sapply(as.data.frame(subDF), function(x)  sum(length(unique(x))==1) ))/ncol(subDF)
 match_pct
 # [1] 0.6

将其包装在自定义函数中：

 fn_matchPercent = function(groupVec =  c("a","d") ) {


 transDF = t(as.matrix(DF))

 subDF  = transDF[rownames(transDF) %in% groupVec,]

 match_pct = sum(sapply(as.data.frame(subDF), function(x)  sum(length(unique(x))==1) ))/ncol(subDF)


 outputDF = data.frame(groups = paste0(groupVec,collapse=",") ,match_pct = match_pct)

 return(outputDF)

 }

 fn_matchPercent(c("a","d"))
   # groups match_pct
 # 1    a,d         1
 fn_matchPercent(c("a","b","d"))
   # groups match_pct
 # 1  a,b,d       0.6
2

试试这个：

find.unanimous.percentage <- function(df, at.a.time) {
  cols <- as.data.frame(t(combn(names(df), at.a.time)))
  names(cols) <- paste('O', 1:at.a.time, sep='')
  cols$percent.unanimous <- 100*colMeans(apply(cols, 1, function(x) apply(df[x], 1, function(y) length(unique(y)) == 1)))
  return(cols)
}

find.unanimous.percentage(df, 2) # take 2 at a time

  O1 O2 percent.unanimous
1  a  b                60
2  a  c                20
3  a  d               100
4  b  c                20
5  b  d                60
6  c  d                20

find.unanimous.percentage(df, 3) # take 3 at a time

  O1 O2 O3 percent.unanimous
1  a  b  c                 0
2  a  b  d                60
3  a  c  d                20
4  b  c  d                 0

find.unanimous.percentage(df, 4)  

  O1 O2 O3 O4 percent.unanimous
1  a  b  c  d                 0
1
是的，你理解问题正确！我在这个 stack overflow 链接上发布了同样的问题。根据建议阅读了外部聚类评估指标后，我发现这些指标需要一些参考/基准，而我没有。我想知道如何使用这些指标。我知道当前的方法不是最优的，它是最坏的情况。如果你有更多的见解，可能会有所帮助... - Haroon Lone
0

尝试这段代码。它适用于您的示例，并且应该适用于扩展情况。

df <- data.frame(a = c(1,2,1,2,1), b=c(1,2,2,1,1), c= c(2,1,2,2,2), d=c(1,2,1,2,1))

# Find all unique combinations of the column names
group_pairs <- data.frame(t(combn(colnames(df), 2)))

# For each combination calculate the similarity
group_pairs$similarities <- apply(group_pairs, 1, function(x) {
  sum(df[x["X1"]] == df[x["X2"]])/nrow(df)
})
感谢您的努力。对于由一对对象组成的群体，计算起来很容易，但如何扩展到由多个对象组成的群体，例如由对象a、b和d组成的群体，确实很困难。 - Haroon Lone
啊，抱歉我误解了问题。 - Eugene Brown
网页内容由stack overflow 提供, 点击上面的
可以查看英文原文，
原文链接