Как посчитать все распространенные случаи появления одного фактора между парными комбинациями уровня другого фактора (предпочтительно с использованием dplyr)?

Question

У меня есть фрейм данных с двумя столбцами, первый соответствует названию фрукта, второй соответствует корзине, в которой он находится.

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

Я бы хотел, чтобы конечный результат былнижняя или верхняя треугольная матрица, где номером корзины являются строки и столбцы, а значением между двумя корзинами является количество общих фруктов.Например, в корзинах 1 и 2 есть 1 общий фрукт, виноград, так что будет 1, в корзинах 1 и 3 есть 1 общий фрукт и т. Д. Для всех возможных комбинаций корзин.Если возможно, я бы хотел, чтобы ответ использовал dplyr!

Спасибо.

Answer 1

Вот довольно компактное решение. Требуется magrittr для составного оператора присваивания (%<>%) и dplyr для mutate. Сначала я создаю фрейм данных.

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

Далее для простоты я конвертирую номера корзин из слов в реальные числа. (Это довольно грязно. Должен быть лучший способ.)

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

Затем я делаю фактический расчет и удаляю диагональ и нижний треугольник (спасибо @smci за однострочник для последнего!):

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

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

, что дает,

#         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

Я предполагаю, что кто-то, более свободно владеющий всеми функциями тидиверса, придет и предложит более компактный способ ответить на вопросы. Но пока вот простой способ решения вашей проблемы с использованием dplyr для некоторых из них.

Чтобы начать замечать, что я добавил столбец, представляющий номера корзин в цифровом виде, это просто делает поднаборы немного более удобными. Затем я создал фрейм данных с отсутствующими значениями с размерами желаемого фрейма выходных данных.

Затем я перебрал различные номера корзин, затем использовал dplyr::filter и dplyr::pull(), чтобы получить вектор фруктов в каждой корзине. Затем я сделал еще один цикл, где я получил вектор фруктов в каждой другой корзине и подсчитал, сколько было общих фруктов.

В конце цикла я заменил столбец в пустом фрейме данных на вектор общих фруктов для этого номера корзины. В конце я поменял столбцы, чтобы сделать их более понятными.

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