<jupyter_start><jupyter_text>library(arules)library(arulesViz)library(dplyr)<jupyter_code># A function for calculating the percentage of transactions where the rule set can be applied
calculate_combined_rules_coverage <- function(rules, transactions){
    
    supporting_trans_tidlist <- arules::supportingTransactions(rules, transactions)
    supporting_trans_list <- unlist(as(supporting_trans_tidlist, "list"), recursive=FALSE)
    round(length(unique(supporting_trans_list)) * 100 / length(transactions), digits=1)
    
}
# Reading the unmodified raw transcations data and product category labels
data_trans <- arules::read.transactions("../../data/raw/trans.csv", sep=',', format='basket', header=TRUE)
data_cat <- read.csv('../../data/clean/product_categories.csv')
# Adding item group category from categories extracted from the png. Some missing values for categories
items <- arules::itemInfo(data_trans)
names(data_cat) <- c('labels', 'level1')
items_with_cat <- merge(x=items, y=data_cat, by = "labels", all.x=TRUE)  
items_with_cat$brand <- substr(items_with_cat$labels, start=0, stop=3)
summary(items_with_cat)
head(items_with_cat)

# assigning the labels to the data
arules::itemInfo(data_trans) <- items_with_cat
# Data is of the size that we expect
length(data_trans)
# How many items does one transaction represent
summary(arules::size(data_trans))
# item labels
length(arules::itemLabels(data_trans))
# there are massive amount of unique items considering that we only have a bit over 10000 transactions. This will be a problem
# Most of the items only appear only in few transactions, with a clear median of 2 (check plot below)
item_freq <- arules::itemFrequency(data_trans, type='absolute')
min(item_freq)
max(item_freq)
mean(item_freq)
median(item_freq)
plot(density(item_freq), main = 'Item Frequency Density', ylab = "Proportion of Transactions that Contain Item", xlab="Number of Transactions with the Item")
# Even for top items combinations the frequencies are quite low compared to the number of transactions
arules::itemFrequencyPlot(data_trans, type='absolute', topN=10)
# There are so many different items and the items are quite rare, that transactions with items does not give much information 
# We must look elsewhere for a good visualization of the dataset
arules::image(sample(data_trans, 10000))
# The support and confidence must be tuned wery low to see a meaningful number of rules
rules <- arules::apriori(data_trans, parameter=list(support=0.001, confidence=0.5, target='rules'))
rules

# Removing redundant and non-significant rules
rules <- rules[!arules::is.redundant(rules)]
rules <- rules[arules::is.significant(rules, data_trans, method='chisq', alpha=0.001, adjust='bonferroni')]

# We are only finding rules that map one item to another. More complex pattern are too rare.
# This also means that there are no redundant rules
arules::inspect(rules)

# Rules apply to less than 2 % of transactions
calculate_combined_rules_coverage(rules, data_trans)
# Visualizing the rules and saving the plots
library(arulesViz)
png("../../reports/figures/apriori_product_level_plot.png")
plot(rules)
dev.off()
plot(rules)
png("../../reports/figures/apriori_product_level_graph.png")
plot(rules, method='graph')
dev.off()
plot(rules, method='graph')
# Trying to use product brand abbreviations with the the actual products
data_trans_brand <- arules::addAggregate(data_trans, by="brand")
# Apple is the dominating brand
png("../../reports/figures/brand_frequency_in_transactions.png")
arules::itemFrequencyPlot(data_trans_brand, type='absolute', topN=10)
dev.off()
arules::itemFrequencyPlot(data_trans_brand, type='absolute', topN=10)
rules_brand <- arules::apriori(
    data_trans_brand, 
    parameter=list(
        support=0.01,  
        confidence=0.4, 
        minlen=2, 
        maxlen=4,
        target='rules'
    )
)

# Dropping redundant, statistically non-significant rules and rules with less than 30 lift
rules_brand <- rules_brand[!arules::is.redundant(rules_brand)]
rules_brand <- rules_brand[arules::is.significant(rules_brand, data_trans_brand, method='chisq', alpha=0.001, adjust='bonferroni')]
rules_brand <- arules::subset(rules_brand, lift >= 2)

arules::inspect(head(rules_brand))

# Rules apply to 25 % of the transactions
calculate_combined_rules_coverage(rules_brand, data_trans_brand)
# Visualizing the rules
library(arulesViz)
png("../../reports/figures/apriori_brand_level_plot.png")
plot(rules_brand)
dev.off()
plot(rules_brand)
png("../../reports/figures/apriori_brand_level_graph.png")
plot(rules_brand, method='graph')
dev.off()
plot(rules_brand, method='graph')
# Trying to use product categories instead of the actual products
data_trans_multlev <- arules::aggregate(data_trans, by="level1")
# Accessories are the dominating category with items from it being contained in around half of the transactions
arules::itemFrequencyPlot(data_trans_multlev, type='absolute')
rules_multlev_high_profit <- arules::apriori(
    data_trans_multlev, 
    parameter=list(
        support=0.01, 
        confidence=0.4, 
        minlen=2, 
        maxlen=4,
        target='rules'
    ),
    appearance=list(
        rhs=c(
            "display",
            "laptop",
            "smartphone",
            "software",
            "tablet",
            "printer",
            "pc"
        ),
        default='lhs'
    )
)

# removing rules that contain accessories, service, other, or extended warranty on the left hand side
rules_multlev_high_profit <- subset(rules_multlev_high_profit, !(lhs %in% c("accessories", "service", "extended warranty")));

# Dropping redundant, statistically non-significant rules and rules with less than 2 lift
rules_multlev_high_profit <- rules_multlev_high_profit[!arules::is.redundant(rules_multlev_high_profit)]
rules_multlev_high_profit <- rules_multlev_high_profit[arules::is.significant(rules_multlev_high_profit, data_trans_multlev, method='chisq', alpha=0.001, adjust='bonferroni')]
rules_multlev_high_profit <- arules::subset(rules_multlev_high_profit, lift >= 1.5)

# Rules apply to 2.7 % of the transactions
calculate_combined_rules_coverage(rules_multlev_high_profit, data_trans_multlev)
# Visualizing the rules
library(arulesViz)
png("../../reports/figures/apriori_product_category_level_plot.png")
plot(rules_multlev_high_profit)
dev.off()
plot(rules_multlev_high_profit)
png("../../reports/figures/apriori_product_category_level_graph.png")
plot(rules_multlev_high_profit, method='graph')
dev.off()
plot(rules_multlev_high_profit, method='graph')<jupyter_output>To reduce overplotting, jitter is added! Use jitter = 0 to prevent jitter.
{'fraction_non_alphanumeric': 0.10952094004218138, 'fraction_numerical': 0.01039469719795119, 'mean_word_length': 5.5797819623389495, 'pattern_counts': {'":': 0, '<': 29, '<?xml version=': 0, '>': 6, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'chain_length': '1', 'dir': 'jupyter-structured-clean-dedup', 'id': '219739', 'license': 'MIT', 'n_tokens_mistral': 2135, 'n_tokens_neox': 1996, 'n_words': 532, 'path': 'notebooks/exploratory/apriori_exploration.ipynb', 'repo_name': 'TuomoKareoja/product-associations-discovery', 'size': '6638'}