R - Speeding up a search with apply

Question

Suppose I have a data.table in which an observation is a pair-wise combination of products my consumers buy together.

I would like to find, for each pair of products (a row in dt) in my data.table, if they have a third product in common that is sometimes also bought with one of the products.

I want to include the "common products" as a new column in dt.

Currently, I do this as follows. But my real data holds millions of rows. It takes 20 hours to compute data from 1 week.

How can I speed this up? Is an apply function smart, or should I think about mapping?

Mock example:

library(data.table)
library(stringi)
library(future.apply)

set.seed(1)

# build mock data
dt <- data.table(V1 = stri_rand_strings(100, 1),
                 V2 = stri_rand_strings(100, 1))

head(dt,17)
#   V1 V2
#1:  G  e
#2:  N  L
#3:  Z  G
#4:  u  z
#5:  C  d
#6:  t  D
# 7:  w  8
# 8:  e  T
# 9:  d  v
#10:  3  b
#11:  C  y
#12:  A  j
#13:  g  M
#14:  N  Q
#15:  l  9
#16:  U  0
#17:  i  i

#function to find common products
find_products <- function(a, b){
  library(data.table)
  toString(unique((dt[.(c(a, b)), on=.(V1), V2[duplicated(V2)]])))
}

#initiate parallel processing
plan(multisession) # on Windows machine - use plan(multicore) on Linux

#apply function across rows
common_products <- future_apply(dt, 1, function(y) find_products(y['V1'], y['V2']))

dt_final <- cbind(dt, common_products)

#head(dt, 17)
#    V1 V2 common_products
# 1:  G  e                
# 2:  N  L                
# 3:  Z  G                
# 4:  u  z                
# 5:  C  d                
# 6:  t  D                
# 7:  w  8                
# 8:  e  T                
# 9:  d  v                
#10:  3  b                
#11:  C  y                
#12:  A  j                
#13:  g  M                
#14:  N  Q                
#15:  l  9                
#16:  U  0                
#17:  i  i      i, z, B, l

user_9463489 · Answer

One can think of the three-way pairs as triangles in an undirected graph. The package igraph can find these efficiently. I included an example with 20M pairs of 3-character product codes. It ran on a single thread in about 70 seconds.

library(data.table)
library(stringi)
library(igraph)

getpaired <- function(g, id) names(unique(neighbors(g, id)))
commonProducts <- function(dt) {
  blnSort <- dt$V1 > dt$V2
  dt[blnSort, c("V2", "V1") := list(V1, V2)] # sort each row
  # get triangles
  g <- graph_from_data_frame(dt, FALSE)
  m <- matrix(V(g)$name[triangles(g)], ncol = 3, byrow = TRUE)
  # sort each row
  m <- matrix(m[order(row(m), m, method = "radix")], ncol = 3, byrow = TRUE)
  dt3 <- as.data.table(m)
  # map common products back to the original dataframe
  dt3 <- rbindlist(
    list(
      # the three ordered pairs in each triangle
      dt3,
      dt3[, c(1, 3, 2)],
      dt3[, c(2, 3, 1)],
      # common products in "two-sided" triangles
      dt[V1 == V2][
        , .(V2 = V2, V3 = .(getpaired(g, V1))), by = "V1"
      ][
        , .(V1 = rep(rep.int(V1, lengths(V3)), 2),
            V2 = c(rep.int(V1, lengths(V3)), unlist(V3)),
            V3 = c(unlist(V3), rep.int(V1, lengths(V3))))
      ][ # sort (V1, V2) in each row
        V1 > V2, c("V2", "V1") := list(V1, V2)
      ]
    ),
    FALSE # bind by index
  )[ # collapse common products into a single vector for each pair
    , .(V3 = .(V3)),
    by = c("V1", "V2")
  ][ # join into the original (row-sorted) data.table
    dt, on = c("V1", "V2")
  ][ # unsort V1, V2 in each row to match the original (unsorted) data.table
    , c("V1", "V2") := dt[blnSort, c("V2", "V1") := list(V1, V2)]
  ]
}

set.seed(1)

# build mock data
dt <- data.table(V1 = stri_rand_strings(100, 1),
                 V2 = stri_rand_strings(100, 1))

dt3 <- commonProducts(dt)
print(dt3)
#>      V1 V2              V3
#>   1:  G  e                
#>   2:  N  L                
#>   3:  Z  G                
#>   4:  u  z                
#>   5:  C  d               B
#>   6:  t  D               t
#>   7:  w  8                
#>   8:  e  T                
#>   9:  d  v                
#>  10:  3  b                
#>  11:  C  y                
#>  12:  A  j                
#>  13:  g  M                
#>  14:  N  Q                
#>  15:  l  9                
#>  16:  U  0                
#>  17:  i  i i,7,E,B,5,z,...
#>  18:  z  6                
#>  19:  N  R               S
#>  20:  m  d                
#>  21:  v  z                
#>  22:  D  U                
#>  23:  e  U                
#>  24:  7  A                
#>  25:  G  k                
#>  26:  N  S               R
#>  27:  0  V                
#>  28:  N  C                
#>  29:  r  E                
#>  30:  L  a                
#>  31:  T  Z                
#>  32:  b  4                
#>  33:  U  2                
#>  34:  B  d             C,6
#>  35:  p  v                
#>  36:  f  b                
#>  37:  n  Y                
#>  38:  6  W               j
#>  39:  i  z               i
#>  40:  P  V                
#>  41:  o  g                
#>  42:  e  b                
#>  43:  m  E                
#>  44:  Y  G                
#>  45:  W  j                
#>  46:  m  S                
#>  47:  1  A                
#>  48:  T  k                
#>  49:  j  6               W
#>  50:  g  r                
#>  51:  T  c                
#>  52:  r  Y                
#>  53:  R  K                
#>  54:  F  S                
#>  55:  4  V                
#>  56:  6  B               d
#>  57:  J  W                
#>  58:  W  4                
#>  59:  f  H                
#>  60:  P  D                
#>  61:  u  H                
#>  62:  I  t               t
#>  63:  S  R               N
#>  64:  K  m                
#>  65:  e  s                
#>  66:  F  P                
#>  67:  T  3                
#>  68:  l  K                
#>  69:  5  i               i
#>  70:  s  K               O
#>  71:  L  d                
#>  72:  q  q           P,q,q
#>  73:  L  r               d
#>  74:  K  O               s
#>  75:  T  N                
#>  76:  t  t       D,I,t,x,t
#>  77:  r  d               L
#>  78:  O  j                
#>  79:  m  b                
#>  80:  x  t               t
#>  81:  Q  I                
#>  82:  i  B               i
#>  83:  O  s               K
#>  84:  K  V                
#>  85:  k  s                
#>  86:  C  B               d
#>  87:  i  l               i
#>  88:  7  i               i
#>  89:  F  w                
#>  90:  8  X                
#>  91:  E  i               i
#>  92:  3  O                
#>  93:  d  6               B
#>  94:  s  v                
#>  95:  m  H                
#>  96:  n  a                
#>  97:  S  6                
#>  98:  P  q               q
#>  99:  o  J                
#> 100:  b  m                
#>      V1 V2              V3

# timing a much larger dataset
dt <- data.table(V1 = stri_rand_strings(2e7, 3),
                 V2 = stri_rand_strings(2e7, 3))

system.time(dt3 <- commonProducts(dt))
#>    user  system elapsed 
#>   72.75    3.05   71.88
dt3[lengths(V3) != 0L] # show only those pairs with common products
#>           V1  V2  V3
#>       1: GBW mDN lxF
#>       2: ix6 jpR 0VI
#>       3: xLG VeE aik
#>       4: A36 RzJ YYu
#>       5: zAo OYu zAo
#>      ---            
#> 1841567: qX9 xrW 7lb
#> 1841568: knO 2G6 knO
#> 1841569: rsU 5Rw ER8
#> 1841570: Bts 3L1 1bQ
#> 1841571: c0h pgd jxJ

This handles "2-sided triangles" created when V1==V2 (as with row 17 in the OP example data). For example, if the entire dataset consisted of the pairs (t, i) and (i, i), then i would be a common product for (t, i) (i is paired with both t and i), and i, t would be the common products for (i, i) (i and t are each paired with both i and i).

user_12158757 · Answer

Update 3 (since `ego` crashes in large graph)

It seems the ego approach in Update 2 crashes due to the large size of netwoek, we probably could try it in a rowwise manner

g <- simplify(graph_from_data_frame(dt, directed = FALSE))
nms <- names(V(g))
dt[
    ,
    common := toString(nms[do.call(intersect, ego(g, 1, unlist(.(V1, V2)), mindist = 1))]),
    .(id = seq_along(V1))
]

Upate 2 (to address the crash issue when using `igraph`)

Considering about the possible crashes caused by using triangles or subgraph_isomorphisms over large igraph object, we can use the following code (maybe sacrifices with some speed but should be a stable workaround)

g <- simplify(graph_from_data_frame(dt, directed = FALSE))
nms <- names(V(g))
transform(
    dt,
    common = Map(
        function(...) nms[intersect(...)],
        ego(g, 1, V1, mindist = 1), 
        ego(g, 1, V2, mindist = 1)
    )
)

Update

I guess You can try subgraph_isomorphisms to find all triangles with all permuations and merge into dt

g <- simplify(graph_from_data_frame(dt, directed = FALSE))
dtg <- as.data.table(do.call(rbind, Map(names, subgraph_isomorphisms(make_ring(3), g))))
dtg[
    dt,
    on = .(V1 = V1, V2 = V2)
][
    ,
    .(common = toString(na.omit(V3))), .(V1, V2)
][
    V1 == V2,
    common := sapply(V1, function(x) toString(names(neighbors(g, x))))
][]

which should be fast and could give you

     V1 V2           common
  1:  G  e
  2:  N  L
  3:  Z  G
  4:  u  z
  5:  C  d                B
  6:  t  D
  7:  w  8
  8:  e  T
  9:  d  v
 10:  3  b
 11:  C  y
 12:  A  j
 13:  g  M
 14:  N  Q
 15:  l  9
 16:  U  0
 17:  i  i l, z, 7, B, 5, E
 18:  z  6
 19:  N  R                S
 20:  m  d
 21:  v  z
 22:  D  U
 23:  e  U
 24:  7  A
 25:  G  k
 26:  N  S                R
 27:  0  V
 28:  N  C
 29:  r  E
 30:  L  a
 31:  T  Z
 32:  b  4
 33:  U  2
 34:  B  d             C, 6
 35:  p  v
 36:  f  b
 37:  n  Y
 38:  6  W                j
 39:  i  z
 40:  P  V
 41:  o  g
 42:  e  b
 43:  m  E
 44:  Y  G
 45:  W  j                6
 46:  m  S
 47:  1  A
 48:  T  k
 49:  j  6                W
 50:  g  r
 51:  T  c
 52:  r  Y
 53:  R  K
 54:  F  S
 55:  4  V
 56:  6  B                d
 57:  J  W
 58:  W  4
 59:  f  H
 60:  P  D
 61:  u  H
 62:  I  t
 63:  S  R                N
 64:  K  m
 65:  e  s
 66:  F  P
 67:  T  3
 68:  l  K
 69:  5  i
 70:  s  K                O
 71:  L  d                r
 72:  q  q                P
 73:  L  r                d
 74:  K  O                s
 75:  T  N
 76:  t  t          D, I, x
 77:  r  d                L
 78:  O  j
 79:  m  b
 80:  x  t
 81:  Q  I
 82:  i  B
 83:  O  s                K
 84:  K  V
 85:  k  s
 86:  C  B                d
 87:  i  l
 88:  7  i
 89:  F  w
 90:  8  X
 91:  E  i
 92:  3  O
 93:  d  6                B
 94:  s  v
 95:  m  H
 96:  n  a
 97:  S  6
 98:  P  q
 99:  o  J
100:  b  m
     V1 V2           common

Previous Answer

Perhaps this could help

library(igraph)

g <- simplify(graph_from_data_frame(dt, directed = FALSE))
dcast(
    melt(dt[, id := 1:.N], "id")[
        ,
        common := toString(names(V(g))[do.call(intersect, ego(g, nodes = value, mindist = 1))]),
        id
    ],
    id + common ~ variable
)[, .(V1, V2, common)]

which gives

     V1 V2           common
  1:  G  e
  2:  N  L
  3:  Z  G
  4:  u  z
  5:  C  d                B
  6:  t  D
  7:  w  8
  8:  e  T
  9:  d  v
 10:  3  b
 11:  C  y
 12:  A  j
 13:  g  M
 14:  N  Q
 15:  l  9
 16:  U  0
 17:  i  i l, z, 7, B, 5, E
 18:  z  6
 19:  N  R                S
 20:  m  d
 21:  v  z
 22:  D  U
 23:  e  U
 24:  7  A
 25:  G  k
 26:  N  S                R
 27:  0  V
 28:  N  C
 29:  r  E
 30:  L  a
 31:  T  Z
 32:  b  4
 33:  U  2
 34:  B  d             C, 6
 35:  p  v
 36:  f  b
 37:  n  Y
 38:  6  W                j
 39:  i  z
 40:  P  V
 41:  o  g
 42:  e  b
 43:  m  E
 44:  Y  G
 45:  W  j                6
 46:  m  S
 47:  1  A
 48:  T  k
 49:  j  6                W
 50:  g  r
 51:  T  c
 52:  r  Y
 53:  R  K
 54:  F  S
 55:  4  V
 56:  6  B                d
 57:  J  W
 58:  W  4
 59:  f  H
 60:  P  D
 61:  u  H
 62:  I  t
 63:  S  R                N
 64:  K  m
 65:  e  s
 66:  F  P
 67:  T  3
 68:  l  K
 69:  5  i
 70:  s  K                O
 71:  L  d                r
 72:  q  q                P
 73:  L  r                d
 74:  K  O                s
 75:  T  N
 76:  t  t          D, I, x
 77:  r  d                L
 78:  O  j
 79:  m  b
 80:  x  t
 81:  Q  I
 82:  i  B
 83:  O  s                K
 84:  K  V
 85:  k  s
 86:  C  B                d
 87:  i  l
 88:  7  i
 89:  F  w
 90:  8  X
 91:  E  i
 92:  3  O
 93:  d  6                B
 94:  s  v
 95:  m  H
 96:  n  a
 97:  S  6
 98:  P  q
 99:  o  J
100:  b  m
     V1 V2           common

user_10112285 · Answer

I believe you can stick with data.table to accomplish what you want to do. As a commenter already pointed out though, you'll need to decide whether product pairings [a,b] are equivalent to [b,a] (in your example answer it is only for pairings [a,b]). Anyway, the bottleneck on this answer is the Map() call; you may be able to eek some more speed out of it with future_Map() but you'll have to test on your actual data to see if it is needed.

Also I want to flag that I kept the common products column as a list-column although you may want it in a different format. Right now it is a mix of NULL's / empty character columns when there is not a match so you may want to clean that up if you keep it as a list-column--up to you.

Solution:

dt_unique = unique(dt[, .(V1, V2)])
dt_pairs = dt_unique[, list(ref_list = list(unique(V2))), .(product = V1)]

dt_unique = dt_pairs[dt_unique, on = c("product" = "V2")]
setnames(dt_unique, c("V2", "V2_ref", "V1"))
dt_unique = dt_pairs[dt_unique, on = c("product" = "V1")]
setnames(dt_unique, c("V1", "V1_ref", "V2", "V2_ref"))

dt_unique[, common_prods := Map(function(x, y) unique.default(y[chmatch(x, y, 0L)]), V1_ref, V2_ref)]

dt_unique[, c("V1_ref", "V2_ref") := NULL]
dt_unique[dt, on = c("V1", "V2")]

     V1 V2 common_prods correct_common_prods
  1:  G  e                                  
  2:  N  L                                  
  3:  Z  G                                  
  4:  u  z                                  
  5:  C  d                                  
  6:  t  D                                  
  7:  w  8                                  
  8:  e  T                                  
  9:  d  v                                  
 10:  3  b                                  
 11:  C  y                                  
 12:  A  j                                  
 13:  g  M                                  
 14:  N  Q                                  
 15:  l  9                                  
 16:  U  0                                  
 17:  i  i      i,z,B,l           i, z, B, l
 18:  z  6                                  
 19:  N  R                                  
 20:  m  d                                  
 21:  v  z                                  
 22:  D  U                                  
 23:  e  U                                  
 24:  7  A                                  
 25:  G  k                                  
 26:  N  S            R                    R
 27:  0  V                                  
 28:  N  C                                  
 29:  r  E                                  
 30:  L  a                                  
 31:  T  Z                                  
 32:  b  4                                  
 33:  U  2                                  
 34:  B  d                                  
 35:  p  v                                  
 36:  f  b                                  
 37:  n  Y                                  
 38:  6  W                                  
 39:  i  z                                  
 40:  P  V                                  
 41:  o  g                                  
 42:  e  b                                  
 43:  m  E                                  
 44:  Y  G                                  
 45:  W  j                                  
 46:  m  S                                  
 47:  1  A                                  
 48:  T  k                                  
 49:  j  6                                  
 50:  g  r                                  
 51:  T  c                                  
 52:  r  Y                                  
 53:  R  K                                  
 54:  F  S                                  
 55:  4  V                                  
 56:  6  B                                  
 57:  J  W                                  
 58:  W  4                                  
 59:  f  H                                  
 60:  P  D                                  
 61:  u  H                                  
 62:  I  t            t                    t
 63:  S  R                                  
 64:  K  m                                  
 65:  e  s                                  
 66:  F  P                                  
 67:  T  3                                  
 68:  l  K                                  
 69:  5  i            i                    i
 70:  s  K                                  
 71:  L  d                                  
 72:  q  q            q                    q
 73:  L  r            d                    d
 74:  K  O                                  
 75:  T  N                                  
 76:  t  t          D,t                 D, t
 77:  r  d                                  
 78:  O  j                                  
 79:  m  b                                  
 80:  x  t            t                    t
 81:  Q  I                                  
 82:  i  B                                  
 83:  O  s                                  
 84:  K  V                                  
 85:  k  s                                  
 86:  C  B            d                    d
 87:  i  l                                  
 88:  7  i            i                    i
 89:  F  w                                  
 90:  8  X                                  
 91:  E  i            i                    i
 92:  3  O                                  
 93:  d  6                                  
 94:  s  v                                  
 95:  m  H                                  
 96:  n  a                                  
 97:  S  6                                  
 98:  P  q            q                    q
 99:  o  J                                  
100:  b  m                                  
     V1 V2 common_prods correct_common_prods

Reproducible code (with comments):

library(data.table)

n = 1e2
set.seed(1)

dt <- data.table(V1 = stringi::stri_rand_strings(n, 1),
                 V2 = stringi::stri_rand_strings(n, 1))

#Matching your output:
find_products <- function(a, b){
  library(data.table)
  toString(unique((dt[.(c(a, b)), on=.(V1), V2[duplicated(V2)]])))
}
dt[, correct_common_prods := apply(dt, 1, function(y) find_products(y[['V1']], y[['V2']]))]


# If (a, b) and (b, a) are equivalent, you'll want this instead:
# dt_unique = unique(rbindlist(list(dt[, .(V1, V2)], dt[, .(V2, V1)]), use.names = FALSE))
dt_unique = unique(dt[, .(V1, V2)])

# Creating list-column w/ corresponding products
dt_pairs = dt_unique[, list(ref_list = list(unique(V2))), .(product = V1)]

# Merging and re-naming. There may be a more data.table way to 
# handle the renaming because this feels not-eloquent
dt_unique = dt_pairs[dt_unique, on = c("product" = "V2")]
setnames(dt_unique, c("V2", "V2_ref", "V1"))
dt_unique = dt_pairs[dt_unique, on = c("product" = "V1")]
setnames(dt_unique, c("V1", "V1_ref", "V2", "V2_ref"))

# This is the memory-intensive part because it checks for the intersection on
# each row. This creates a list-column `common_prods`
# OR, easier to read but slower: 
# dt_unique[, common_prods := Map(intersect, V1_ref, V2_ref)]
dt_unique[, common_prods := Map(function(x, y) unique.default(y[chmatch(x, y, 0L)]), V1_ref, V2_ref)]

# Column cleanup (retain _ref columns to better understand how this works)
# then merging in the common products
dt_unique[, c("V1_ref", "V2_ref") := NULL]
dt = dt_unique[dt, on = c("V1", "V2")]

user_6356278 · Answer

This problem lookes like a market basket analysis, so I'd suggest to approach it as such.

Probelm with ramdom sample data, is that you will most likely not find any strong correlations between products since your data is ramdom ;-). But perhaps (hopefully) this will not be the case in your production-dataset(s).

There is a great tutorial on basket analysis on datacamp, which I followed (mostly) for this answer. For more in-depth information, make sure to follow the tutorial yourself. Link is in de code's comments below.

# Workflow adapted from 
#   https://www.datacamp.com/community/tutorials/market-basket-analysis-r
library(arules)
library(arulesViz)
library(tidyverse)

# Put items bought together intoa single column, separate with comma
#  then convert into transactions
write.csv(setDF(dt) %>% unite("items", everything(), sep = ","),
          "./temp/my_transactions.csv", 
          quote = FALSE, row.names = FALSE)
# Now read the csv into a transactions file
tr <- read.transactions("./temp/my_transactions.csv", 
                        format = "basket", sep = ",")

# Frequency plot (for getting insight only, so commented out)
#   itemFrequencyPlot(tr, topN = 15, type = "absolute", main="Absolute Item Frequency Plot")
#   itemFrequencyPlot(tr, topN = 15, type = "relative", main="Absolute Item Frequency Plot")

# Mine rules
# since your sample data is rather small and ramdom.. 
# there will not be many items bought together frequently...
# so I set the confidence to 0.5 (i.e. 50%).
# If your data set grows, you should/can increase the confidence 
# to get more reliable pairing
association.rules <- apriori(tr, parameter = list(supp = 0.001, conf = 0.5, maxlen = 100))

# what have we found here?
inspect(association.rules)
#      lhs    rhs support    confidence coverage   lift      count
# [1]  {x} => {t} 0.00990099 1.0        0.00990099 25.250000 1    
# [2]  {5} => {i} 0.00990099 1.0        0.00990099 14.428571 1    
# [3]  {c} => {T} 0.00990099 1.0        0.00990099 16.833333 1    
# [4]  {1} => {A} 0.00990099 1.0        0.00990099 33.666667 1    
# [5]  {p} => {v} 0.00990099 1.0        0.00990099 25.250000 1    
# [6]  {2} => {U} 0.00990099 1.0        0.00990099 25.250000 1    
# [7]  {9} => {l} 0.00990099 1.0        0.00990099 33.666667 1    
# [8]  {M} => {g} 0.00990099 1.0        0.00990099 33.666667 1    
# [9]  {y} => {C} 0.00990099 1.0        0.00990099 25.250000 1    
# [10] {X} => {8} 0.00990099 1.0        0.00990099 50.500000 1    
# [11] {8} => {X} 0.00990099 0.5        0.01980198 50.500000 1    
# [12] {q} => {P} 0.00990099 0.5        0.01980198 12.625000 1    
# [13] {a} => {n} 0.00990099 0.5        0.01980198 25.250000 1    
# [14] {n} => {a} 0.00990099 0.5        0.01980198 25.250000 1    
# [15] {a} => {L} 0.00990099 0.5        0.01980198 12.625000 1    
# [16] {0} => {U} 0.00990099 0.5        0.01980198 12.625000 1    
# [17] {0} => {V} 0.00990099 0.5        0.01980198 12.625000 1    
# [18] {u} => {H} 0.00990099 0.5        0.01980198 16.833333 1    
# [19] {u} => {z} 0.00990099 0.5        0.01980198 12.625000 1    
# [20] {Q} => {I} 0.00990099 0.5        0.01980198 25.250000 1    
# [21] {I} => {Q} 0.00990099 0.5        0.01980198 25.250000 1    
# [22] {Q} => {N} 0.00990099 0.5        0.01980198  8.416667 1    
# [23] {Z} => {G} 0.00990099 0.5        0.01980198 12.625000 1    
# [24] {Z} => {T} 0.00990099 0.5        0.01980198  8.416667 1    
# [25] {f} => {H} 0.00990099 0.5        0.01980198 16.833333 1    
# [26] {f} => {b} 0.00990099 0.5        0.01980198  8.416667 1    
# [27] {n} => {Y} 0.00990099 0.5        0.01980198 16.833333 1    
# [28] {o} => {J} 0.00990099 0.5        0.01980198 25.250000 1    
# [29] {J} => {o} 0.00990099 0.5        0.01980198 25.250000 1    
# [30] {o} => {g} 0.00990099 0.5        0.01980198 16.833333 1    
# [31] {J} => {W} 0.00990099 0.5        0.01980198 12.625000 1    
# [32] {I} => {t} 0.00990099 0.5        0.01980198 12.625000 1    
# [33] {w} => {8} 0.00990099 0.5        0.01980198 25.250000 1    
# [34] {8} => {w} 0.00990099 0.5        0.01980198 25.250000 1    
# [35] {w} => {F} 0.00990099 0.5        0.01980198 16.833333 1    
# [36] {7} => {A} 0.00990099 0.5        0.01980198 16.833333 1    
# [37] {7} => {i} 0.00990099 0.5        0.01980198  7.214286 1 

# what does the above mean?
#    [1] 100% of people that have bought x, also bought t
#   [11]  50% of people that have bought 8, also bought X

# visualise
plot(association.rules, method = "graph",  engine = "htmlwidget")

plot(association.rules, method="paracoord")

user_6851825 · Answer

My apologies if I'm misunderstanding the question (it does reproduce the example, fwiw), but this seems like it might be doable more efficiently as a simple join. For n = 10M, this runs in about 3 seconds.

My data.table is rusty so I'm using dtplyr to convert my dplyr to data.table syntax. I presume there are data.table optimizations to make this faster, or you could use the collapse package.

Setup

library(data.table)
library(dplyr)   
library(dtplyr)    
library(stringi)
n = 10000000
set.seed(1)
dt <- data.table(V1 = stri_rand_strings(n, 2),  # 3,844 groups
                 V2 = stri_rand_strings(n, 2))

Join of V2 to each associated V1

dt_single <- distinct(dt, V1)
dt_single %>%
  left_join(dt, by = c("V1" = "V1")) %>%
  group_by(V1) %>%
  summarize(common_products = paste(V2, sep = ", ", collapse = ", "))

To get the output in the same format as the OP, we could assign the code above to -> common and then do:

dt %>%
  left_join(common) %>%
  mutate(common_products = if_else(V1 == V2, common_products, "")) %>% 
  select(V1, V2, common_products)

to get the OP desired output, as far as I can tell:

   V1    V2    common_products
               
 1 G     e                   
 2 N     L                   
 3 Z     G                   
 4 u     z                   
 5 C     d                   
 6 t     D                   
 7 w     8                   
 8 e     T                   
 9 d     v                   
10 3     b                   
11 C     y                   
12 A     j                   
13 g     M                   
14 N     Q                   
15 l     9                   
16 U     0                   
17 i     i     i, z, B, l  
...

R - Speeding up a search with apply

5 Answers

Update 3 (since ego crashes in large graph)

Upate 2 (to address the crash issue when using igraph)

Update

Previous Answer

Update 3 (since `ego` crashes in large graph)

Upate 2 (to address the crash issue when using `igraph`)