In anhhd/VPBank1: Basket Analysis with Shiny App for VP Bank (one line, title case)

library(flexdashboard)
library(arules)
library(arulesViz)
library(visNetwork)
library(igraph)
library(dplyr)
library(DT)

#PHẦN A: XỬ LÝ DỮ LIỆU

###########################

#Bước 1: Tạo rules
rules <-  apriori(Transaction, 
                  parameter = list(supp = a(),conf=b(), minlen = 2), appearance = list(default="rhs",lhs= d()))
subset.matrix <- is.subset(rules, rules)
subset.matrix[lower.tri(subset.matrix, diag=T)] <- NA
redundant <- colSums(subset.matrix, na.rm=T) >= 1
rules.pruned <- rules[!redundant]
subrules2 <- sort(rules.pruned, by="lift")

#Bước 2.1: Tạo object plot
ig <- plot( subrules2, method="graph", control=list(type="items"))

#Bước 2.2: Convert ra data frame
ig_df <- get.data.frame(ig, what = "both")

##################

#Bước 3: Data Manipulation

#Bước 3.1: Đếm số rules
no.of.rules <- dim(subrules2@quality)[1]
#Bước 3.2: Đếm số quan sát trong object igraph
no.of.obs <- length(ig_df$vertices$confidence)

#Bước 3.3 Tạo data frame cho visNetwork

#Bước 3.3.1: Tạo object data.frame của nodes và edges

edges = ig_df$edges

##################

nodes = data.frame(
  id = ig_df$vertices$name
  ,label = ifelse(ig_df$vertices$label == "","", ig_df$vertices$label))

#LƯU Ý: Object của IG_DF bị lệch 1 quan sát, do đó cần điều chỉnh lại để 
#data frame nodes chính xác

#Các bước nhỏ
#Tạo vector confidence theo chuẩn apriori
value.confidence <- c(NA,ig_df$vertices$confidence[-no.of.obs])
#Tạo vector support chuẩn theo apriori
value.support <- c(NA,ig_df$vertices$support[-no.of.obs])
#Tạo vector lift chuẩn theo apriori
value.lift <- c(NA,ig_df$vertices$lift[-no.of.obs])

#Check Target
rooted.item.id <- (edges %>% filter(to == "r1"))[1] %>% as.integer

#Tạo màu cho các nodes
nodes$color[(no.of.obs - no.of.rules +1):no.of.obs] <- "red"

#Màu của target có màu khác
nodes$color[nodes$id == rooted.item.id] <- "darkgreen"

#nodes$color[1:(no.of.obs - no.of.rules)] <- "rgb(11,142,82)"
nodes$value <- value.lift
#Tạo title khi hover
nodes$title <- paste0(
  "Support:", round(value.support * 100,3), "%", "\n",                        "Confidence:", round(value.confidence * 100, 3),"%","\n",                   "Lift:", round(value.lift, 3))

Column {.tabset data-width=1000}

Association Rules

visNetwork(nodes, edges, height = "100%", width = "100%",
           main = paste("Frequent Patterns for", d())) %>% 
  visEdges(arrows = "to") %>% 
  visOptions(highlightNearest = TRUE, nodesIdSelection = TRUE) %>% 
  visExport()
#%>% visHierarchicalLayout(direction = "UD") #Create layout

Summary Rules

subrules2 %>% summary

Column {.tabset data-width=700}

Rules in Detail

ruledf <- as(subrules2, "data.frame")
datatable(ruledf, rownames = F,
          caption = "Association Rules in Detail",
          extensions = "AutoFill", options = list(autoFill = TRUE)) %>% 
 formatPercentage(c(2,3),3) %>% 
 formatRound(c(4),3)