Question

更新2 *我添加了一些代码（和解释），我在这个问题的最后写了自己，但这是一个次优的解决方案（在编码效率方面都是产生的输出）但是有点设法选择符合条件的项目。限制。如果您对如何改进它有任何想法（再次将效率作为结果输出），请告诉我。

1。更新后的帖子

请查看下面的初始问题和示例代码。感谢 alexis_laz 他的回答问题解决了少数几个项目。但是，当项目数量变得很大时，由于combn错误， R 中的invalid 'ncol' value (too large or NA)函数无法再计算它。由于我的数据集确实有很多项目，我想知道用 C ++ 替换他的一些代码（在此之后显示）是否为此提供了解决方案，如果是这种情况，我应该使用哪些代码为了这？ TNX！

这是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中有一个矩阵对象，其中rows = persons（100000），columns = items（220），如果该人已经创建了该项，则在单元格中为1;如果该人未创建该项目，则为0 。

如何使用R来确定至少15项的哪个组合是由最多的人做出的？

希望问题很清楚（如果不是，请向我询问更多细节，我很乐意提供这些）。

提前Tnx。

Joost的

编辑：

下面是一个样本矩阵，其中项目（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

如果至少有2件由至少3人制作;

> 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)

Answer 1

跟进我的评论，例如：

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

Answer 2

这是与您的输出匹配的另一个想法：

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 = ", "))))         
                  }))
}      
ff(mat, 3, 3)
#  persons   items
#1 1, 3, 5 A, B, C
ff(mat, 2, 3)
#     persons   items
#1 1, 2, 3, 5    A, B
#2    1, 3, 5    A, C
#3 1, 3, 4, 5    B, C
#4    1, 3, 5 A, B, C

矩阵中出现的模式最多 - R（UPDATE）

1。更新后的帖子

2。初始帖子

3。书面代码

2 个答案: