是否存在用于识别每行中“ n”个匹配项的R函数？

Question

I am attempting to aggregate my data to find correlations/patterns, and want to discover how and where data may correlate. Specifically, I want to identify how many times an id (here called 'item') appear together. Is there a way to find how many times each (id) appear together in a row?

This is for a larger data.frame that has already been cleaned and aggregated based on this particular inquiry. In the past, I have tried to apply multiple aggregation, summation and filter functions from packages like 'data.table','dplyr', and 'tidyverse' but cannot quite get what I am looking for.

In section 3( Show some code ) I have provided a minimal reproducible example:

set.seed(1234)
random.people<-c("Bob","Tim","Jackie","Angie","Christopher")
number=sample(12345:12350,2000,replace = T)
item=sample(random.people,2000,replace=T)

sample_data <- data.frame(cbind(number,item), stringsAsFactors = FALSE)

Using the examples here ,I expected the output to ID all the combinations where names were aggregated to a number and show the n (value) - expecting results to resemble something like:

Pair       value
Bob, Tim     2
Bob, Jackie  4
Bob, Angie   0

This output (what I am hoping to get) would tell me that in the entire df, there are 2 times that Bob and Tim and 4 times that Bob and Jackie both have the same number.

but the actual output is:

Error: Each row of output must be identified by a unique combination of keys.

Keys are shared for 2000 rows:
* 9, 23, 37, 164, 170, 180, 211...

Update: I thought of a..creative(?) solution - but hope someone can help with expedting it. I can locate all the numbers (column1) that are shared between two names using the following:

x1<-sample_data %>% dplyr::filter(item=="Bob")
x2<-sample_data %>% dplyr::filter(item=="Tim")
Bob<-x1[,1]
Tim<-x2[,1]
Reduce(intersect, list(Bob,Tim))

output:

[1] "12345" "12348" "12350" "12346" "12349" "12347"

Like I said, this is very time consuming and would require creating a plethora of vectors and intersecting each(eg 1 vector for each name) and multiple combinations.

Answer 1

set.seed(1234)
random.people<-c("Bob","Tim","Jackie","Angie","Christopher")
number=sample(12345:22350,2000,replace = T) # I edited ur number here.
item=sample(random.people,2000,replace=T)

sample_data <- data.frame(cbind(number,item), stringsAsFactors = FALSE)

library(tidyverse)
sample_data %>%
  # find out unique rows
  distinct() %>%
  # nest the data frame into nested tibble, so now you have
  # a "data" column, which is a list of small data frames.
  group_nest(number) %>%
  # Here we use purrr::map to modify the list column. We want each 
  # combination counts only once despite the order, so we use sort. 
  mutate(data = map_chr(data, ~paste(sort(.x$item), collapse = ", "))) %>%
  # the last two steps just count the numbers
  group_by(data) %>%
  count()

# A tibble: 21 x 2
# Groups:   data [21]
   data                         n
   <chr>                    <int>
 1 Angie                      336
 2 Angie, Bob                   8
 3 Angie, Bob, Christopher      2
 4 Angie, Bob, Jackie           1
 5 Angie, Christopher          16
 6 Angie, Jackie                9
 7 Angie, Tim                  10
 8 Bob                        331
 9 Bob, Christopher            12
10 Bob, Christopher, Jackie     1
# … with 11 more rows

One possible solution

Answer 2

Here's a base R solution which relies on table -> aggregate and potentially an inefficient way to paste the names together using apply .

tab_data <-  data.frame(unclass(table(unique(sample_data))))
#table results in columns c(Angie.1, Bob.1, ...) - this makes it look better
names(tab_data) = sort(random.people) 

library(network)
plot.network.default(as.network(tab_data))

tab_data$n <- 1

agg_data <- aggregate(n~., data = tab_data, FUN = length)
agg_data$Pair <- apply(agg_data[, -length(agg_data)], 1, function(x) paste(names(x[x!=0]), collapse = ', '))


agg_data[order(agg_data$Pair), c('Pair', 'n') ]

                            Pair   n
1                          Angie 336
3                     Angie, Bob   8
7        Angie, Bob, Christopher   2
11            Angie, Bob, Jackie   1
5             Angie, Christopher  16
9                  Angie, Jackie   9
15                    Angie, Tim  10
2                            Bob 331
6               Bob, Christopher  12
... truncated ...

As far as performance, on this relatively small data set, it's around 9x faster than the dplyr solution:

Unit: milliseconds
           expr     min       lq     mean   median       uq      max neval
  base_solution  9.4795  9.65215 10.80984  9.87625 10.32125  46.8230   100
 dplyr_solution 78.6070 81.72155 86.47891 83.96435 86.40495 200.7784   100

Data

set.seed(1234)
random.people<-c("Bob","Tim","Jackie","Angie","Christopher")
number=sample(12345:22350,2000,replace = T) # I edited ur number here.
item=sample(random.people,2000,replace=T)

sample_data <- data.frame(number,item, n = 1L, stringsAsFactors = FALSE)