#membuat rules dengan minimum support 0.01 dan confidence 0.7
rules <- apriori(item_id,parameter = list(supp = 0.01, conf = 0.7))## Apriori
##
## Parameter specification:
## confidence minval smax arem aval originalSupport maxtime support minlen
## 0.7 0.1 1 none FALSE TRUE 5 0.01 1
## maxlen target ext
## 10 rules TRUE
##
## Algorithmic control:
## filter tree heap memopt load sort verbose
## 0.1 TRUE TRUE FALSE TRUE 2 TRUE
##
## Absolute minimum support count: 59
##
## set item appearances ...[0 item(s)] done [0.00s].
## set transactions ...[5299 item(s), 5942 transaction(s)] done [0.24s].
## sorting and recoding items ... [2312 item(s)] done [0.01s].
## creating transaction tree ... done [0.00s].
## checking subsets of size 1 2 3 4 5 6 7## Warning in apriori(item_id, parameter = list(supp = 0.01, conf = 0.7)): Mining
## stopped (time limit reached). Only patterns up to a length of 7 returned!## done [5.32s].
## writing ... [3724465 rule(s)] done [0.90s].
## creating S4 object ... done [1.28s].## lhs rhs support confidence coverage lift count
## [1] {SPRING DEC , HANGING CHICK CREAM} => {WHITE HANGING HEART T-LIGHT HOLDER} 0.01026590 0.8026316 0.01279031 3.192260 61
## [2] {50'S CHRISTMAS PAPER GIFT BAG} => { 50'S CHRISTMAS GIFT BAG LARGE} 0.01093908 0.7647059 0.01430495 42.866815 65
## [3] {POTTING SHED COFFEE MUG} => {POTTING SHED TEA MUG} 0.01194884 0.8658537 0.01380007 13.646956 71
## [4] {SET OF 36 DOILIES SPACEBOY DESIGN } => {PACK OF 60 SPACEBOY CAKE CASES} 0.01144396 0.8607595 0.01329519 9.816954 68
## [5] {WHITE CHRISTMAS TREE DECORATION } => {WHITE CHRISTMAS STAR DECORATION} 0.01009761 0.7792208 0.01295860 40.615174 60
## [6] {LARGE CAKE TOWEL, CHOCOLATE SPOTS} => {LARGE CAKE TOWEL PINK SPOTS} 0.01110737 0.7500000 0.01480983 25.760116 66Let’s create network for 50 rules that has the highest lift
# hanya mengambbil 100 rules dengan lift tertinggi
subrules <- head(rules, n = 100, by = "lift")
inspect(head(subrules))## lhs rhs support confidence coverage lift count
## [1] {GREEN SPOTTY CUP,
## PINK SPOTTY PLATE ,
## RED SPOTTY PLATE } => {GREEN SPOTTY PLATE } 0.01060249 0.9264706 0.01144396 61.85492 63
## [2] {GREEN SPOTTY CUP,
## PINK SPOTTY CUP,
## PINK SPOTTY PLATE ,
## RED SPOTTY PLATE } => {GREEN SPOTTY PLATE } 0.01060249 0.9264706 0.01144396 61.85492 63
## [3] {GREEN SPOTTY CUP,
## PINK SPOTTY PLATE ,
## RED SPOTTY CUP,
## RED SPOTTY PLATE } => {GREEN SPOTTY PLATE } 0.01026590 0.9242424 0.01110737 61.70616 61
## [4] {GREEN SPOTTY CUP,
## PINK SPOTTY CUP,
## PINK SPOTTY PLATE ,
## RED SPOTTY CUP,
## RED SPOTTY PLATE } => {GREEN SPOTTY PLATE } 0.01026590 0.9242424 0.01110737 61.70616 61
## [5] {BLUE SPOTTY CUP,
## GREEN SPOTTY CUP,
## PINK SPOTTY PLATE ,
## RED SPOTTY PLATE } => {GREEN SPOTTY PLATE } 0.01009761 0.9230769 0.01093908 61.62835 60
## [6] {BLUE SPOTTY CUP,
## GREEN SPOTTY CUP,
## PINK SPOTTY CUP,
## PINK SPOTTY PLATE ,
## RED SPOTTY PLATE } => {GREEN SPOTTY PLATE } 0.01009761 0.9230769 0.01093908 61.62835 60#membuat data frame dari rules
df_rules <- DATAFRAME(subrules) %>% rowid_to_column("rules") %>% mutate(rules = paste("Rules",
rules), RHS = str_remove_all(string = RHS, pattern = "[{}]"))
df_rules#menyiapkan data untuk dibuat network dari kolom item
df_items <- df_rules %>% mutate(LHS = str_remove_all(string = LHS, pattern = "[{}]")) %>%
separate(col = LHS, into = c(paste0("item_", 1:3)), sep = ",") %>% pivot_longer(cols = c(item_1,
item_2, item_3), names_to = "antecedent", values_to = "item") %>% select(rules,
antecedent, item, RHS, everything()) %>% filter(is.na(item) == F)## Warning: Expected 3 pieces. Additional pieces discarded in 40 rows [2, 3, 4, 5,
## 6, 10, 14, 16, 17, 18, 20, 43, 48, 57, 59, 60, 61, 65, 67, 69, ...].## Warning: Expected 3 pieces. Missing pieces filled with `NA` in 34 rows [7, 11,
## 22, 23, 25, 26, 29, 30, 33, 34, 35, 36, 38, 39, 41, 42, 46, 49, 50, 51, ...].#membuat titik dan kotak entitas yang akan di gambar
nodes <- data.frame(name = unique(c(df_items$item, df_items$RHS, df_items$rules))) %>%
rowid_to_column("id") %>% mutate(group = ifelse(str_detect(name, "Rules"), "A",
"B"), label = name, value = c(rep(NA, n_distinct(c(df_items$item, df_items$RHS))),
df_rules$lift), support = c(rep(NA, n_distinct(c(df_items$item, df_items$RHS))),
df_rules$support), confidence = c(rep(NA, n_distinct(c(df_items$item, df_items$RHS))),
df_rules$confidence), shape = ifelse(group == "A", "circle", "box"), color = ifelse(group ==
"A", "lightblue", "lightgreen"), title = ifelse(test = group == "A", yes = paste(name,
"<br> Lift:", round(value, 2), "<br> Confidence:", round(confidence, 2), "<br> Support:",
round(support, 2)), no = as.character(name)))
nodes#membuat garis penghubung antar nodes
edges <- data.frame(from = df_items$item, to = df_items$rules) %>% bind_rows(data.frame(from = df_rules$rules,
to = df_rules$RHS)) %>% left_join(nodes, by = c(from = "name")) %>% select(id,
to) %>% rename(from = id) %>% left_join(nodes, by = c(to = "name")) %>% select(from,
id) %>% rename(to = id) %>% mutate(color = ifelse(to <= 33, "red", "lightgreen"))
edges# memvisualisasikan networknya atau hubungan antar nodes
visNetwork(nodes = nodes, edges = edges, height = "500px", width = "100%") %>% visEdges(arrows = "to") %>%
visOptions(highlightNearest = T) %>% visInteraction(tooltipStyle = "position: fixed; visibility: hidden; padding: 5px; white-space: nowrap;
font-size: 18px; color: black; background-color: white; border-color: orange")Green spotty cup mempertemukan 2 network yag berbeda garis merah menunjukan dari item ke rules garis hijau dari item ke rules untuk menunjukan bahwa item tersebut merupakan pendahulunya atau indikator utama barang yang selanjutnya akan di beli