如何将函数应用于数据框中的所有行组合？

Question

我无法解决以下关于（通过限制列数简化）数据框“注释”的问题。

require(irr)
# data
annotations <- read.table(text = "Obj1    Obj2    Obj3
Rater1     a       b       c
Rater2     a       b       b
Rater3     a       b       c", header = TRUE, stringsAsFactors = FALSE)

我想将 irr 包中的函数同意应用于行的所有组合（不是排列），结果如下。

Agreement rater 1-2: 67%
Agreement rater 1-3: 100%
Agreement rater 2-3: 67%

我需要对所有行组合运行一个函数，并且该函数需要访问多个/所有列。

我已经想出了问题的部分答案；我已经生成了一个运行combn(rownames(annotations), 2) 的组合列表，但是我不知道如何使用这个列表而不编写低效的 for 循环。

我已经尝试过应用，如apply(annotations, 1, agree)，但我只能让它在一行上工作，而不是前面提到的组合。

有人知道如何进行吗？

更新：根据您的建议，以下解决方案有效。 （我使用了 irr 包中的 kappa2 而不是 agree，但主要问题的解决方案保持不变。）

require(irr) #require the irr library for agreement calculations
annotations <- read.table(text = "Obj1    Obj2    Obj3
Rater1     a       b       c
Rater2     a       b       b
Rater3     a       b       c
Rater4     c       a       a", header = TRUE, stringsAsFactors = FALSE)

annotations <- t(annotations) #transpose annotations (rows become columns and vice versa)
kappa_list <- combn(colnames(annotations), 2, FUN=function(x) kappa_list[[length(kappa_list)+1]] = kappa2(matrix(c(annotations[,x[1]], annotations[,x[2]]), ncol=2))$value) #fill kappa_list with all pairs of columns (combinations of 2 raters) in annotations and, per combination, add a value to kappa_list that consists of the value of kappa2 applied to the current combination of raters
kappa_list # display the list of values

Answer 1

你很接近，你只需要apply combn 的结果。我不知道你指的是什么函数，但是如果你插入你的函数，这应该是一样的。

首先，将结果另存为列表，因为添加名称更容易（我将两个条目组合在一起添加）：

toCheck <- combn(rownames(annotations), 2, simplify = FALSE)

names(toCheck) <-
  sapply(toCheck, paste, collapse = " - ")

然后，使用sapply 完成您的组合。在这里，我使用mean 进行比较，但在这里使用您需要的。如果您返回多个值，请使用lapply，然后根据需要使用结果进行打印

sapply(toCheck, function(x){
  mean(annotations[x[1], ] == annotations[x[2], ])
})

返回：

Rater 1 - Rater 2 Rater 1 - Rater 3 Rater 2 - Rater 3 
        0.6666667         1.0000000         0.6666667 

Answer 2

将函数f(x):= 2x+5 应用于与组合对应的列的所有条目。代替f(x):= 2x+5，可以编写自己的函数：

第一步：设计具体的组合数据框。 （以下是我自己的情况）

causalitycombinations <- function (nvars, ncausers, ndependents)
{
    independents <- combn(nvars, ncausers)
    swingnumber <- dim(combn(nvars - ncausers, ndependents))[[2]]
    numberofallcombinations <- dim(combn(nvars, ncausers))[[2]] * swingnumber
    dependents <- matrix(, nrow = dim(combn(nvars, ncausers))[[2]] * swingnumber, ncol = ndependents)
    for (i in as.integer(1:dim(combn(nvars, ncausers))[[2]])) {
        dependents[(swingnumber * (i - 1) + 1):(swingnumber * i), ] <- t(combn(setdiff(seq(1:nvars), independents[, i]), ndependents))
    }
    swingedindependents <- matrix(, nrow = dim(combn(nvars, ncausers))[[2]] * swingnumber, ncol = ncausers)
    for (i in as.integer(1:dim(combn(nvars, ncausers))[[2]])) {
        for (j in as.integer(1:swingnumber)) {
            swingedindependents[(i - 1) * swingnumber + j, ] <- independents[, i]
        }
    }
    independentsdependents <- cbind(swingedindependents, dependents)
    others <- matrix(, nrow = dim(combn(nvars, ncausers))[[2]] * swingnumber, ncol = nvars - ncausers - ndependents)
    for (i in as.integer(1:((dim(combn(nvars, ncausers))[[2]]) * swingnumber))) {
        others[i, ] <- setdiff(seq(1:nvars), independentsdependents[i, ])
    }
    causalitiestemplate <- cbind(independentsdependents, others)
    causalitiestemplate
}

    causalitycombinations(3,1,1)
#     [,1] [,2] [,3]
#[1,]    1    2    3
#[2,]    1    3    2
#[3,]    2    1    3
#[4,]    2    3    1
#[5,]    3    1    2
#[6,]    3    2    1

第 2 步：将数据附加到组合
（一个可以追加多列，为简单起见我只添加了1）

set.seed(1)
mydataframer <- cbind(causalitycombinations(3,1,1), rnorm(6))
mydataframer
 #     [,1] [,2] [,3]       [,4]
 #[1,]    1    2    3 -0.6264538
 #[2,]    1    3    2  0.1836433
 #[3,]    2    1    3 -0.8356286
 #[4,]    2    3    1  1.5952808
 #[5,]    3    1    2  0.3295078
 #[6,]    3    2    1 -0.8204684

第三步：通过lapply应用函数，同时考虑复合数据帧的行数

lapply(1: dim(mydataframer)[[1]], function(x) {2*mydataframer[x,4] + 5})

# 3.747092
# 5.367287
# 3.328743
# 8.190562
# 5.659016
# 3.359063

就是这样。

顺便说一句，?irr::agree 帮助文件指出nxm 评分矩阵/数据框是“n 个主题，m 个评分者”。因此，提问者可以通过以下方式更好地设计：

annotations <- read.table(text = "Rater1    Rater2    Rater3
Subject1     a       b       c
Subject2     a       b       b
Subject3     a       b       c", header = TRUE, stringsAsFactors = FALSE)

annotations
#         Rater1 Rater2 Rater3
# Subject1      a      b      c
# Subject2      a      b      b
# Subject3      a      b      c

此外，还需要澄清一件事，提问者是否要遍历所有此类注释组合。如果是这样的话，即，

annotations
#         Rater1 Rater2 Rater3
# Subject1      a      a      a
# Subject2      a      a      a
# Subject3      a      a      a

annotations
#         Rater1 Rater2 Rater3
# Subject1      a      a      b
# Subject2      a      a      a
# Subject3      a      a      a

annotations
#         Rater1 Rater2 Rater3
# Subject1      a      a      c
# Subject2      a      a      a
# Subject3      a      a      a

annotations
#         Rater1 Rater2 Rater3
# Subject1      a      b      a
# Subject2      a      a      a
# Subject3      a      a      a

# .... after consuming all Subject1 possibilities, this time consuming Subject2 possibilities,

annotations
#         Rater1 Rater2 Rater3
# Subject1      a      a      a
# Subject2      a      a      b
# Subject3      a      a      a

然后是Subject3的可能性，从而收集协议的所有可能性，那么问题就彻底改变了。

irr::agree 函数专为 多个 行设计。从它的帮助文件中观察：

data(video)
video
#   rater1 rater2 rater3 rater4
# 1       4      4      3      4
# 2       4      4      4      5
# ..............................
# 20      4      5      5      4

agree(video)     # Simple percentage agreement
# Percentage agreement (Tolerance=0)
# Subjects = 20; Raters = 4; %-agree = 35 

agree(video, 1)  # Extended percentage agreement
# Percentage agreement (Tolerance=1)
# Subjects = 20; Raters = 4; %-agree = 90 

而如果提问者想要逐行同意（只有1个主题！），%-同意总是 0:

agree(video[1,])
# Percentage agreement (Tolerance=0)
# Subjects = 1; Raters = 4; %-agree = 0

...

agree(video[20,])
# Percentage agreement (Tolerance=0)
# Subjects = 1; Raters = 4; %-agree = 0