更新2
*我在问题末尾添加了一些代码(和解释)，这是我自己写的，但这不是次优的解决方案(既将编码效率作为结果输出)，又设法选择了符合条件的项目。约束。如果您有任何关于如何改进它的想法(同样要兼顾效率和产出)，请告诉我。
1.更新后
请在下面查看初始问题和示例代码。谢谢 alexis_laz 他的回答是为少数项目解决了问题。但是，当项目数变大时，中的combn函数R 无法再计算它，因为invalid 'ncol' value (too large or NA)错误。由于我的数据集确实有很多项目，我想知道是否用 C++替换了他的一些代码(此后显示)提供了解决方案，如果是这种情况，我应该为此使用什么代码？天哪!
这是alexis_laz提供的代码；
ff = function(x, No_items, No_persons)
{
do.call(rbind,
lapply(No_items:ncol(x),
function(n) {
col_combs = combn(seq_len(ncol(x)), n, simplify = F)
persons = lapply(col_combs, function(j) rownames(x)[rowSums(x[, j, drop = F]) == n])
keep = unlist(lapply(persons, function(z) length(z) >= No_persons))
data.frame(persons = unlist(lapply(persons[keep], paste, collapse = ", ")),
items = unlist(lapply(col_combs[keep], function(z) paste(colnames(x)[z], collapse = ", "))))
}))
}
2.初始职位
目前，我正在处理来自自适应测量的一组数据，这意味着并非所有人都做出了相同的项目。但是，对于我的分析，我需要一个仅包含所有人(或这些人的子集)制作的项目的数据集。
我在R中有一个矩阵对象，其中的行=人员(100000)，列=项目(220)，如果该人员已创建项目，则在单元格中为1，如果该人员未创建项目，则为0。
如何使用R确定由最多人数组成的至少15种商品的组合？
希望这个问题很清楚(如果不能，请向我询问更多详细信息，我会很乐意提供)。
提前Tnx。
乔斯特
编辑:
下面是一个示例矩阵，其中项目(A:E)为列，人员(1:5)为行。
mat <- matrix(c(1,1,1,0,0,1,1,0,1,1,1,1,1,0,1,0,1,1,0,0,1,1,1,1,0),5,5,byrow=T)
colnames(mat) <- c("A","B","C","D","E")
rownames(mat) <- 1:5
> mat
A B C D E
"1" 1 1 1 0 0
"2" 1 1 0 1 1
"3" 1 1 1 0 1
"4" 0 1 1 0 0
"5" 1 1 1 1 0
mat [1,1] = 1表示人1对项目1做出了回应。
现在(在此示例中)，我有兴趣找出至少3个人制作了至少3件物品中的哪一组。因此，在这里，我可以检查3、4和5个项目的所有可能组合，以检查组合中每个项目的矩阵中有1个人的人数。
这将导致我选择物料组合A，B和C，因为它是3人(即1、3和5人)制作的物料的唯一组合。
现在，对于我的真实数据集，我想执行此操作，但是对于至少10个项目的组合，一组至少75人都做出了响应。并且由于我有很多数据，最好不像示例数据中那样手工处理。
因此，我正在寻找R中的函数/代码，这将使我选择最少数量的项目和问题，然后让我获得所有项目组合以及遵守这些约束或拥有更多项目/人员的人员/人比受约束。
因此，对于示例矩阵，它将类似于:
f <- function(data,no.items,no.persons){
#code
}
> f(mat,3,3)
no.item no.pers items persons
1 3 3 A, B, C 1, 3, 5
或至少由3个人制作的至少2件物品；
> f(mat,2,3)
no.item no.pers items persons
1 2 4 A, B 1, 2, 3, 5
2 2 3 A, C 1, 3, 5
3 2 4 B, C 1, 3, 4, 5
4 3 3 A, B, C 1, 3, 5
希望这可以弄清我的问题的实质。 Tnx我已经收到的快速回复!
3.书面代码
以下是我今天编写的代码。它以每个项目一次为起点，然后查看也对起始项目做出响应的人回答最多的项目。它把这两个项目拿到第三个项目，然后重复此过程，直到回答所有选定问题的人数降至给定限制以下。该代码的一个缺点是运行需要一些时间(当项目数量增加时，它会以指数形式上升)。第二个缺点是，这仍然无法评估项目的所有可能组合，从某种意义上说，开始项目和随后选择的项目可能会有很多人共同回答这些项目，但是如果选择的项目几乎与其他(尚未选择)的项目没有相似性，因此样本收缩可能非常快。虽然如果选择一个项目时与开始项目的共同点较少，并且该项目与其他项目有很多联系，那么根据下面使用的代码，所选项目的最终集合可能比该项目的最终集合大得多。因此，再次欢迎双方提出建议和改进!
set.seed(512)
mat <- matrix(rbinom(1000000, 1, .6), 10000, 100)
colnames(mat) <- 1:100
fff <- function(data,persons,items){
xx <- list()
for(j in 1:ncol(data)){
d <- matrix(c(j,length(which(data[,j]==1))),1,2)
colnames(d) <- c("item","n")
t = persons+1
a <- j
while(t >= persons){
b <- numeric(0)
for(i in 1:ncol(data)){
z <- c(a,i)
if(i %in% a){
b[i] = 0
} else {
b[i] <- length(which(rowSums(data[,z])==length(z)))
}
}
c <- c(which.max(b),max(b))
d <- rbind(d,c)
a <- c(a,c[1])
t <- max(b)
}
print(j)
xx[[j]] = d
}
x <- y <- z <- numeric(0)
zz <- matrix(c(0,0,rep(NA,ncol(data))),length(xx),ncol(data)+2,byrow=T)
colnames(zz) <- c("n.pers", "n.item", rep("I",ncol(data)))
for(i in 1:length(xx)){
zz[i,1] <- xx[[i]][nrow(xx[[i]])-1,2]
zz[i,2] <- length(unname(xx[[i]][1:nrow(xx[[i]])-1,1]))
zz[i,3:(zz[i,2]+2)] <- unname(xx[[i]][1:nrow(xx[[i]])-1,1])
}
zz <- zz[,colSums(is.na(zz))<nrow(zz)]
zz <- zz[which((rowSums(zz,na.rm=T)/rowMeans(zz,na.rm=T))-2>=items),]
zz <- as.data.frame(zz)
return(zz)
}
fff(mat,110,8)
> head(zz)
n.pers n.item I I I I I I I I I I
1 156 9 1 41 13 80 58 15 91 12 39 NA
2 160 9 2 27 59 13 81 16 15 6 92 NA
3 158 9 3 59 83 32 25 80 14 41 16 NA
4 160 9 4 24 27 71 32 10 63 42 51 NA
5 114 10 5 59 66 27 47 13 44 63 30 52
6 158 9 6 13 56 61 12 59 8 45 81 NA
#col 1 = number of persons in sample
#col 2 = number of items in sample
#col 3:12 = which items create this sample (NA if n.item is less than 10)
最佳答案
跟进我的评论，例如:
set.seed(1618)
mat <- matrix(rbinom(1000, 1, .6), 100, 10)
colnames(mat) <- sample(LETTERS, 10)
rownames(mat) <- sprintf('person%s', 1:100)
mat1 <- mat[rowSums(mat) > 5, ]
head(mat1)
# A S X D R E Z K P C
# person1 1 1 1 0 1 1 1 1 1 1
# person3 1 0 1 1 0 1 0 0 1 1
# person4 1 0 1 1 1 1 1 0 1 1
# person5 1 1 1 1 1 0 1 1 0 0
# person6 1 1 1 1 0 1 0 1 1 0
# person7 0 1 1 1 1 1 1 1 0 0
table(rowSums(mat1))
# 6 7 8 9
# 24 23 21 5
tab <- table(sapply(1:nrow(mat1), function(x)
paste(names(mat1[x, ][mat1[x, ] == 1]), collapse = ',')))
data.frame(tab[tab > 1])
# tab.tab...1.
# A,S,X,D,R,E,P,C 2
# A,S,X,D,R,E,Z,P,C 2
# A,S,X,R,E,Z,K,C 3
# A,S,X,R,E,Z,P,C 2
# A,S,X,Z,K,P,C 2
关于c++ - 哪个模式在矩阵中出现最多-R(更新)，我们在Stack Overflow上找到一个类似的问题： https://stackoverflow.com/questions/24703462/