R中两两意义分组标签的自动算法

在与这个问题斗争了一段时间之后，我希望在这里得到一些建议。我想知道是否有人知道一种根据重要性自动确定成对分组标签的方法。该问题独立于显著性检验（例如，Tukey表示参数或Mann-Whitney表示非参数）-鉴于这些成对比较，一些箱线图类型的图形通常用子脚本表示这些分组：

我已经手工完成了这个示例，这可能会非常乏味。我认为，算法中的标记顺序应基于每个组中的级别数-例如，应首先命名包含与所有其他级别显著不同的单个级别的组，然后命名包含2个级别的组，然后命名3个级别，以此类推。，始终检查新分组是否添加了新的所需分组，并且没有冲突和差异

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

示例代码：

set.seed（1）
首先让我用图论的语言重申这个问题。定义一个图形，如下所示。每个样本都会产生一个表示它的顶点。两个顶点之间存在一条边，当且仅当某些测试表明这些顶点所代表的样本在统计上无法区分时。在图论中，团是一组顶点，在该集合中的每两个顶点之间都有一条边。我们正在寻找一个派系集合，使得图中的每条边都属于（至少？确切地说？）一个派系。我们希望使用尽可能少的派系。（这个问题称为集团边缘覆盖，而不是集团覆盖。）然后，我们为每个集团分配自己的字母，并用该字母标记其成员。每个有别于其他样品的样品都有自己的字母

例如，与示例输入相对应的图形可以这样绘制

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

我提出的算法如下。构造图并使用该图查找所有最大团。对于上面的图，它们是{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应该有一个整数规划求解器的接口，我们可以使用整数规划来确定最佳的派系集合。（如果其他方法不充分，我将对此进行更多解释。）
我想我会发布我能够从以下方面获得额外帮助的解决方案：

set.seed（1）
nCool代码

我认为调用
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))))
)
))

reordi如果我理解正确，并且您想要最小数量的标签，那么这就是。是的，正确-尽可能少的标签数量。你知道在R中有这样一个实现吗？可以有多少人口？我根本不是R用户。@Davidisenstat-我试图找到一些通用的解决方案，我可以用于各种情况-不仅仅是这里包含7个级别的示例。非常感谢你。你帮了我大忙，而另一半来自于此。非常感谢！我使用的是R3.0.1，我必须用当前的
igraph
version
reord删除行“res”，看起来您可以通过将第二个do.call中的部分更改为
lappy（res，function（x）c（sort（as.vector（x）），rep.int（0，ml length（x）），将其更新为新版本）
。在2015年的更新中，igraph取消了自动将顶点视为向量的功能（请参见：）。也就是说，我不能100%确定它是否与之前的重新排序步骤重复。
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)

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