如何计算一个因子的所有常见事件，在另一个因子水平的成对组合之间（最好使用dplyr）？

Question

I have a data frame with two columns, the first corresponding to the name of a fruit, the second corresponding to the basket it's found in.

fruit_basket <- data.frame("fruit" = c("apple", "grapes", "banana", "grapes", "mangos", "apple", "mangos", "banana"),
"basket" = c("one", "one", "two", "two", "three", "three", "four", "four"))

I'd like the end result to be a lower or upper triangular matrix where the basket number are the rows and columns, and the value between two baskets are the number of common fruits. For example, baskets one and two share 1 common fruit, grapes, so there would be a 1, baskets one and three share 1 common fruit, and so forth for all possible basket combinations. If possible I'd like the answer to use dplyr!

Thank you.

Answer 1

Here's a fairly compact solution. It requires magrittr for the compound assignment operator ( %<>% ) and dplyr for mutate . First, I create the data frame.

# Data frame
fruit_basket <- data.frame("fruit" = c("apple", "grapes", "banana", "grapes", "mangoes", "apple", "mangoes", "banana"),
                           "basket" = c("one", "one", "two", "two", "three", "three", "four", "four"))

Next, I convert basket numbers from words to actual numbers for simplicity. (This is pretty cludgy. There must be a better way.)

# Load libraries
library(magrittr)
library(dplyr)

# Convert words to numbers -- there has to be a better way!!!
fruit_basket %<>%
  mutate(basket = case_when(
    basket == "one" ~ 1,
    basket == "two" ~ 2,
    basket == "three" ~ 3,
    basket =="four" ~ 4
  ))

Then, I do the actual calculation and remove the diagonal and lower triangle (thanks to @smci for the one-liner for the latter!):

# Build table then calculate cross product 
res <- crossprod(table(fruit_basket))

# Remove lower triangle & diagonals
res[lower.tri(res, diag=T)] <- NA

which gives,

#         basket
# basket  1  2  3  4
#      1 NA  1  1  0
#      2 NA NA  0  1
#      3 NA NA NA  1
#      4 NA NA NA NA

Answer 2

I imagine somebody more fluent in all the functions of the tidyverse will come along and offer a more compact way of answering the questions. But for now, here is a simple way of solving your problem while using dplyr for some of it.

To start notice that I added a column representing the basket numbers numerically, this just makes subsetting a little more convenient. Then I created a dataframe of missing values with the dimensions of the desired output dataframe.

Next, I looped through the different basket numbers, then used dplyr::filter and dplyr::pull() to get a vector of the fruits in each basket. I then did another loop, where I got a vector of the fruits in each of the other baskets, and got the count for how many shared fruits there were.

At the end of the loop, I replaced the column in the empty data frame with the vector of shared fruits for that basket number. At the end, I relabeled the columns to make it a bit more clear.

library(dplyr)

fruit_basket <- data.frame("fruit" = c("apple", "grapes", "banana", "grapes", "mangos", "apple", "mangos", "banana"),
                           "basket" = c("one", "one", "two", "two", "three", "three", "four", "four"),
                           stringsAsFactors = FALSE)


fruit_basket$basket_number <- c(rep(1, 2), rep(2, 2), rep(3, 2), rep(4, 2))



output_df <- data.frame(matrix(NA, nrow = 4, ncol = 4))

for (i in 1:max(fruit_basket$basket_number)) {

  fruits_in_current_basket <- fruit_basket %>% 
    filter(basket_number == i) %>% 
    pull(fruit)

  basket_count <- c()

  for (j in 1:4) {

    if (j == i) {

      shared_fruits <- 2

    }

    else {

      fruits_in_comparison_basket <- fruit_basket %>% 
        filter(basket_number == j) %>% 
        pull(fruit)

      shared_fruits <- sum(fruits_in_current_basket %in% fruits_in_comparison_basket)

    }

    basket_count <- c(basket_count, shared_fruits)


  }


  output_df[, i] <- basket_count


}
colnames(output_df) <- c("basket_one", "basket_two", "basket_three", "basket_four")