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

У меня есть набор данных случаев, которые набирают 0-1 балла по группе двоичных атрибутов.

Что я хочу сделать, так это извлечь все возможные комбинации троек атрибутов (например, A / B / C, A / B / D … из AE), а затем суммировать для каждой возможной тройки комбинаций, сколько раз в исходном случае dataframe соответствует этим атрибутам.

С использованием dplyr логика а также lapply Я могу решить эту проблему, но производительность очень низкая, особенно для больших фреймов данных и большего количества возможных атрибутов. Мой реальный фрейм данных приводит к тестовой матрице из> 1000 возможных триплетов, и функция с этим очень плохо справляется.

Пожалуйста, помогите мне оптимизировать код, в идеале оставаясь в рамках dplyr рамки как можно больше.

library(tidyverse)


# Create a test data frame and vector of relevant variables
test_df <- data.frame(ID = c(1,2,3,4), Target = c(1,1,0,0),F_A = c(1,0,0,1),F_B = c(0,1,0,1),F_C = c(1,1,0,0),F_D = c(0,1,1,0),F_E = c(1,0,0,1))
invars = c("F_A","F_B","F_C","F_D","F_E")
NumOfElements = 3

# Create a full matrix of all relevant variables in NumOfElements-combinations
combn(invars,NumOfElements) %>%
  t() %>%
  as.data.frame() %>%
  rowid_to_column("ID") %>%
  select(ID, T1 = V1, T2 = V2, T3 = V3) %>%
  unite("Test",starts_with("T"),sep = "|",remove = FALSE,na.rm = TRUE) %>%
  {.} -> test_matrix


# Brute Force Function to calculate number of all IDs that fullfill the test rules
bruteForce_size = function(rule_iterator,source_df,invars){
  source_df %>%
    pivot_longer(cols = c(-ID,-Target), names_to = "Affinity", values_to = "Value") %>%
    mutate(Value = ifelse(Value ==1, Affinity,NA_character_)) %>%
    pivot_wider(names_from = Affinity, values_from = Value) %>%
    unite("Test",invars,sep = "|",remove = FALSE,na.rm = TRUE) %>%
    mutate(Size = as.numeric(rule_iterator == Test)) %$%
    sum(Size)
}

# Calculate and attach sizes to test_matrix
test_matrix %>%
  mutate(Size = unlist(lapply(Test, bruteForce_size, test_df)))