用于在R中自动化成对有效分组标签的算法

Question

在努力解决这个问题一段时间后，我希望在这里得到一些建议。 我想知道是否有人知道一种基于显着性确定成对分组标签的自动方法。 这个问题与重要性测试无关（例如Tukey用于参数化或Mann-Whitney用于非参数） - 给定这些成对比较，一些boxplot类型的数字通常用子脚本表示这些分组：

我手工完成了这个例子，这可能很乏味。 我认为算法中的标记顺序应该基于每个组中的级别数 - 例如，那些包含与所有其他级别显着不同的单个级别的组应该首先命名，然后是包含2个级别的组，然后是3，等等，检查新分组是否添加了新的所需分组，并且没有违反和差异。

在下面的示例中，棘手的部分是让算法识别级别1应该与3和5分组，但3和5不应该分组（即共享标签）。

示例代码：

set.seed(1)
n <- 7
n2 <- 100
mu <- cumsum(runif(n, min=-3, max=3))
sigma <- runif(n, min=1, max=3)

dat <- vector(mode="list", n)
for(i in seq(dat)){
    dat[[i]] <- rnorm(n2, mean=mu[i], sd=sigma[i])
}

df <- data.frame(group=as.factor(rep(seq(n), each=n2)), y=unlist(dat))

bp <- boxplot(y ~ group, df, notch=TRUE)
kr <- kruskal.test(y ~ group, df)
kr
mw <- pairwise.wilcox.test(df$y, df$g)
mw
mw$p.value > 0.05 # TRUE means that the levels are not significantly different at the p=0.05 level

#      1     2     3     4     5     6
#2 FALSE    NA    NA    NA    NA    NA
#3  TRUE FALSE    NA    NA    NA    NA
#4 FALSE FALSE FALSE    NA    NA    NA
#5  TRUE FALSE FALSE FALSE    NA    NA
#6 FALSE FALSE FALSE  TRUE FALSE    NA
#7 FALSE FALSE FALSE FALSE FALSE FALSE

text(x=1:n, y=bp$stats[4,], labels=c("AB", "C", "A", "D", "B", "D", "E"), col=1, cex=1.5, pos=3, font=2)

Answer 1

很酷的代码。

我认为你需要在调用do.call时引用函数order（）：

reord<-do.call("order", data.frame(
do.call(rbind, 
    lapply(res, function(x) c(sort(x), rep.int(0, ml-length(x))))
)
))

Answer 2

首先让我用图论的语言重述这个问题。 按如下方式定义图表。 每个样本都会产生一个代表它的顶点。 在两个顶点之间，当且仅当某些测试表明由这些顶点表示的样本无法在统计上进行区分时，才存在边。 在图论中， clique是一组顶点，使得在集合中的每两个顶点之间存在边。 我们正在寻找一系列派系，以便图中的每个边缘都属于（至少？完全？）其中一个派系。 我们想尽可能少地使用派系。 （这个问题被称为clique edge cover，而不是clique cover。）然后我们为每个clique分配自己的字母，并用该字母标记其成员。 每个可与其他样本区分的样本也有自己的字母。

例如，可以像这样绘制与样本输入对应的图形。

3---1---5       4--6

我提出的算法如下。 构造图并使用Bron - Kerbosch算法查找所有最大派系。 对于上图，这些是{1,3}，{1,5}和{4,6}。 例如，集合{1}是一个集团，但它不是最大集合，因为它是集团{1,3}的一个子集。 集合{1,3,5}不是集团，因为在3和5之间没有边缘。在图中

  1
 / \
3---5       4--6,

最大派系将是{1,3,5}和{4,6}。

现在递归搜索一个小集团边缘封面。 递归函数的输入是一组剩余要覆盖的边和最大派系列表。 找到剩余集合中的最小边，例如，边（1,2）<（1,5）<（2,3）<（2,5）<（3,4）。 对于包含此边缘的每个最大集团，构造由该集团组成的候选解决方案和递归调用的输出，其中从剩余的边缘集合中移除集团边缘。 输出最佳候选人。

除非边缘很少，否则这可能太慢了。 第一个性能改进是memoize：维护从输入到递归函数输出的映射，这样我们就可以避免两次完成工作。 如果这不起作用，那么R应该有一个整数程序求解器的接口，我们可以使用整数编程来确定最好的集团集合。 （如果另一种方法不充分，我会解释更多。）

Answer 3

我想我会发布我能够从以下问题获得额外帮助的解决方案：

set.seed(1)
n <- 7
n2 <- 100
mu <- cumsum(runif(n, min=-3, max=3))
sigma <- runif(n, min=1, max=3)

dat <- vector(mode="list", n)
for(i in seq(dat)){
    dat[[i]] <- rnorm(n2, mean=mu[i], sd=sigma[i])
}
df <- data.frame(group=as.factor(rep(seq(n), each=n2)), y=unlist(dat))
bp <- boxplot(y ~ group, df, notch=TRUE)


#significance test
kr <- kruskal.test(y ~ group, df)
mw <- pairwise.wilcox.test(df$y, df$g)

#matrix showing connections between levels
g <- as.matrix(mw$p.value > 0.05)
g <- cbind(rbind(NA, g), NA)
g <- replace(g, is.na(g), FALSE)
g <- g + t(g)
diag(g) <- 1
rownames(g) <- 1:n
colnames(g) <- 1:n
g

#install.packages("igraph")
library(igraph)

# Load data
same <- which(g==1)
topology <- data.frame(N1=((same-1) %% n) + 1, N2=((same-1) %/% n) + 1)
topology <- topology[order(topology[[1]]),] # Get rid of loops and ensure right naming of vertices
g3 <- simplify(graph.data.frame(topology,directed = FALSE))
get.data.frame(g3)

# Plot graph
plot(g3)

# Calcuate the maximal cliques
res <- maximal.cliques(g3)

# Reorder given the smallest level
res <- sapply(res, sort)
res <- res[order(sapply(res,function(x)paste0(sort(x),collapse=".")))]

ml<-max(sapply(res, length))
reord<-do.call(order, data.frame(
    do.call(rbind, 
        lapply(res, function(x) c(sort(x), rep.int(0, ml-length(x))))
    )
))
res <- res[reord]

lab.txt <- vector(mode="list", n)
lab <- letters[seq(res)]
for(i in seq(res)){
    for(j in res[[i]]){
        lab.txt[[j]] <- paste0(lab.txt[[j]], lab[i])
    }
}

bp <- boxplot(y ~ group, df, notch=TRUE, outline=FALSE, ylim=range(df$y)+c(0,1))
text(x=1:n, y=bp$stats[5,], labels=lab.txt, col=1, cex=1, pos=3, font=2)