计算每组所有可能的对答案

【问题标题】：Count all possible pairs per group计算每组所有可能的对
【发布时间】：2017-01-14 20:53:42
【问题描述】：

我找不到与此相关的帖子，但如果有人询问并回答了类似的问题，我深表歉意。如果我有以下数据：

Market  Product Test
A       1       1
A       2       1
A       3       0
A       4       1
B       1       0
B       2       0
B       3       1
B       4       1
C       1       1
C       2       1
C       3       0
C       4       0

如果 Test = 1，则产品存在于市场中。如果我想计算所有产品市场组合中两种产品共存的市场数量，我该怎么做？例如，1&2 = 2； 1&3 = 0; 1&4 = 1。

我已经使用 dplyr 计算了每种产品的市场总和：

Answer <- Data %>% 
            group_by(Market) %>% 
            summarise(ProductCount = sum(Test))

【问题讨论】：

你也可以显示你想要的输出吗？
tab = crossprod(table(d[d$Test==1, -3])) ; tab[lower.tri(tab, diag=TRUE)] <- NA ; reshape2::melt(tab, na.rm=TRUE) 。如果您想要每个市场的计数数，请更改 diag=FALSE

标签： r dplyr

【解决方案1】：

看起来像 table 在具有 Test == 1 的行中的工作：

 (combMkt <- with(  Data[ Data$Test==1, ], table(Market, Product)) )
#-- the starting point of all Test=1 rows:
      Product
Market 1 2 3 4
     A 1 1 0 1
     B 0 0 1 1
     C 1 1 0 0

# Choose the ones with 2 or more Markets
 combMkt[ , which( apply( combMkt, 2, sum) >=2 )]
      Product
Market 1 2 4
     A 1 1 1
     B 0 0 1
     C 1 1 0

【讨论】：

【解决方案2】：

这是一个仅使用基数 R 的想法。我们在 Market 上 aggregate 并在 Test == 1 时获得所有可能的组合。然后我们使用table 来计算配对并将它们排列在data.frame中

d1 <- aggregate(Product ~ Market, df[df$Test == 1,], FUN = function(i)combn(i, 2, FUN = toString))
d2 <- as.data.frame(table(unlist(d1$Product)), stringsAsFactors = FALSE)

d2
#  Var1 Freq
#1 1, 2    2
#2 1, 4    1
#3 2, 4    1
#4 3, 4    1

但是，如果您想包括所有未出现的对，那么，

n <- setdiff(combn(unique(df$Product), 2, toString), d2$Var1)
rbind(d2, data.frame(Var1 = n, Freq = 0, stringsAsFactors = FALSE))

#  Var1 Freq
#1 1, 2    2
#2 1, 4    1
#3 2, 4    1
#4 3, 4    1
#5 1, 3    0
#6 2, 3    0

【讨论】：

【解决方案3】：

下面的n.markets 函数给出了你想要的计数矩阵。前两行给出产品对，例如第一列显示货币对 1&2，第三行显示市场计数。

dat <- data.frame(Market = c(rep('A',4),rep('B',4),rep('C',4)), Product = rep(1:4,3), Test = c(1,1,0,1,0,0,1,1,1,1,0,0))


n.markets <- function(dat){
    combs  <- combn(unique(dat$Product),2)
    mkts   <- unique(as.vector(dat$Market))
    counts <- rep(0,ncol(combs))
    for(j in 1:ncol(combs)){
        for(i in seq_along(mkts)){
            counts[j] <- counts[j] + (sum(dat[dat$Market==mkts[i] & dat$Product %in% combs[,j], 'Test'])==2)
        }
    }
    rbind(combs,counts)
}

n.markets(dat)

##        [,1] [,2] [,3] [,4] [,5] [,6]
##           1    1    1    2    2    3
##           2    3    4    3    4    4
## counts    2    0    1    0    1    1

编辑：user20650评论中的答案要快得多

tab = crossprod(table(d[d$Test==1, -3]))
tab[lower.tri(tab, diag=TRUE)] <- NA
reshape2::melt(tab, na.rm=TRUE)

【讨论】：