package Data::Mining::AssociationRules;
use strict;
use warnings;
BEGIN {
use Exporter ();
use vars qw ($AUTHOR $VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
$AUTHOR = 'Dan Frankowski <dfrankow@winternet.com>';
@EXPORT = @EXPORT_OK = qw(generate_frequent_sets
generate_rules
read_frequent_sets
read_transaction_file
set_debug);
%EXPORT_TAGS = ();
@ISA = qw(Exporter);
$VERSION = 0.1;
}
my $debug = 0;
=head1 NAME
Data::Mining:AssociationRules - Mine association rules and frequent
sets from data.
=head1 SYNOPSIS
use Data::Mining::AssociationRules;
my %transaction_map;
my $transaction_file = "foo.txt";
read_transaction_file(\%transaction_map, $transaction_file);
generate_frequent_sets(\%transaction_map, $output_file_prefix,
$support_threshold, $max_n);
generate_rules($output_file_prefix, $support_threshold,
$confidence_threshold, $max_n);
read_frequent_sets($set_map_ref, $file_prefix)
set_debug(1);
perl arm.pl -transaction-file foo.txt -support 2 -confidence-threshold 0.01 -max-set-size 6
See also FUNCTIONS, DESCRIPTION, and EXAMPLES below.
=head1 INSTALLATION
The typical:
=over
=item 0 perl Makefile.PL
=item 0 make test
=item 0 make install
=back
=head1 FUNCTIONS
=cut
=pod
=head2 read_transaction_file($transaction_map_ref, $transaction_file)
Read in a transaction map from a file which has lines of two
whitespace-separated columns:
=over
transaction-id item-id
=back
=cut
sub read_transaction_file {
my $transaction_map_ref = shift;
my $transaction_file = shift;
open(BFILE, $transaction_file) or die "Couldn't open $transaction_file: $!\n";
while ( <BFILE> ) {
my @data = split;
die "Expected 2 columns, found ", int(@data), "\n" if int(@data) != 2;
my ($tid, $item) = @data;
$$transaction_map_ref{$item}{$tid}++;
}
close(BFILE);
}
=pod
=head2 generate_frequent_sets ($transaction_map_ref, $file_prefix, $support_threshold, $max_n)
Given
=over
=item 0 a map of transactions
=item 0 a file prefix
=item 0 a support threshold
=item 0 a maximum frequent set size to look for (optional)
=back
generate the frequent sets in some files, one file per size of the set.
That is, all 1-sets are in a file, all 2-sets in another, etc.
The files are lines of the form:
=over
support-count item-set
=back
where
=over
=item 0 support-count is the number of transactions in which the item-set appears
=item 0 item-set is one or more space-separated items
=back
=cut
sub generate_frequent_sets {
my $transaction_map_ref = shift;
my $file_prefix = shift;
my $support_threshold = shift;
my $max_n = shift;
# Generate 1-sets
my $n = 1;
my $out_nset = nset_filename($n, $file_prefix, $support_threshold);
open(OUT, ">$out_nset") or die "Couldn't open $out_nset for writing: $!\n";
while (my ($item, $item_map) = each %{$transaction_map_ref}) {
my $support = int(keys(%$item_map));
if ($support >= $support_threshold) {
print OUT "$support $item\n";
}
}
my $num_nsets = int(keys(%{$transaction_map_ref}));
print STDERR "$num_nsets $n-sets\n" if $debug;
close(OUT);
# Generate n-sets
my $done = 0;
while ($num_nsets > 0) {
$n++;
$num_nsets = 0;
last if defined($max_n) && ($n > $max_n);
# Go through (n-1)-sets, pruning as you go
my $prior_nset = nset_filename($n-1, $file_prefix, $support_threshold);
open(PRIOR, $prior_nset) or die "Couldn't open $prior_nset: $!\n";
$out_nset = nset_filename($n, $file_prefix, $support_threshold);
open(OUT, ">$out_nset") or die "Couldn't open $out_nset: $!\n";
while ( <PRIOR> ) {
my ($count, @set) = split;
# Create userset, which contains the intersection of $transaction{@set}
my %userset = % {$$transaction_map_ref{$set[0]}};
foreach my $item ( @set[1 .. $#set] ) {
while (my ($user, $dummy) = each %userset) {
if (!exists($$transaction_map_ref{$item}{$user})) {
delete($userset{$user});
}
}
}
# For each 1-set, intersect further, and spit out if > support_threshold
while (my ($item, $user_set) = each %{$transaction_map_ref}) {
# Only spit sets of non-decreasing elements
# This keeps out duplicates
my $dup_set = 0;
foreach my $set_item ( @set ) {
if ($set_item ge $item) {
$dup_set = 1;
last;
}
}
if (!$dup_set) {
my %newset = %userset;
while (my ($user, $dummy) = each %newset) {
if (!exists($$user_set{$user})) {
delete($newset{$user});
}
}
#print "newset is now " . map_str(\%newset) . "\n";
my $num_users = int(keys(%newset));
#print "item $item set @set numusers is $num_users\n";
if ($num_users >= $support_threshold) {
print OUT "$num_users @set $item\n";
$num_nsets++;
}
}
}
}
close(PRIOR);
close(OUT);
print STDERR "$num_nsets $n-sets\n" if ($num_nsets > 0) && $debug;
unlink($out_nset) if 0 == $num_nsets;
}
}
=pod
=head2 read_frequent_sets($set_map_ref, $file_prefix)
Given
=over
=item 0 a set map
=item 0 a file prefix
=item 0 support threshold
=item 0 max frequent set size (optional)
=back
read all the frequent sets into a single map, which has as its key the
frequent set (joined by single spaces) and as its value the support.
=cut
sub read_frequent_sets {
my $set_map_ref = shift;
my $file_prefix = shift;
my $support_threshold = shift;
my $max_n = shift;
opendir(DIR, '.') || die "can't opendir '.': $!";
my @files = grep { /^$file_prefix/ && -f "./$_" } readdir(DIR);
closedir DIR;
foreach my $file (@files) {
# print STDERR "Read file $file ..\n";
if ( $file =~ /${file_prefix}\-support\-(\d+)\-(\d+)set/ ) {
my $support = $1;
my $n = $2;
next if ($support != $support_threshold)
|| (defined($max_n) && ($n > $max_n));
open(SETS, $file) or die "Couldn't open $file: $!\n";
while ( <SETS> ) {
my ($count, @set) = split;
$$set_map_ref{join(' ', @set)} = $count;
}
close(SETS);
}
}
}
# =pod
# =head2 nset_filename($n, $file_prefix, $support_threshold)
# Given
# =over
# =item 0 set size
# =item 0 a file prefix
# =item 0 a support threshold
# =back
# return the name of the file that contains the specified frequent sets.
# =cut
sub nset_filename {
my $n = shift;
my $file_prefix = shift;
my $support_threshold = shift;
return $file_prefix . "-support-" . $support_threshold . "-" . $n . "set.txt";
}
=pod
=head2 generate_rules($file_prefix, $support_threshold, $max_n)
Given
=over
=item 0 a file prefix
=item 0 a support threshold (optional)
=item 0 a confidence threshold (optional)
=item 0 maximum frequent set size to look for (optional)
=back
create a file with all association rules in it. The output file is of
the form:
support-count confidence left-hand-set-size right-hand-set-size frequent-set-size left-hand-set => right-hand-set
=cut
sub generate_rules {
my $file_prefix = shift;
my $support_threshold = shift;
my $confidence_threshold = shift;
my $max_n = shift;
$support_threshold = 1 if !defined($support_threshold);
$confidence_threshold = 0 if !defined($confidence_threshold);
my $num_rules = 0;
# Read in frequent set supports
my %frequent_set;
read_frequent_sets(\%frequent_set, $file_prefix, $support_threshold, $max_n);
die "Found no frequent sets from file prefix $file_prefix support $support_threshold " if (0 == int(keys(%frequent_set)));
# Go through the sets computing stats
my $rulefile = $file_prefix . '-support-' . $support_threshold . '-conf-' .
$confidence_threshold . '-rules.txt';
open(RULES, ">$rulefile") or die "Couldn't open $rulefile: $!\n";
while (my ($set, $count) = each %frequent_set) {
# Traverse all subsets (save full and empty)
my $support = $frequent_set{$set};
die "Couldn't find frequent set '$set'" if !defined($support);
my @set = split('\s+', $set);
for my $lhs_selector (1..(1<<int(@set))-2) {
my @lhs_set = @set[grep $lhs_selector&1<<$_, 0..$#set];
my $all_ones = (1<<int(@set))-1;
my $rhs_selector = $all_ones ^ $lhs_selector;
my @rhs_set = @set[grep $rhs_selector&1<<$_, 0..$#set];
# print "lhs_selector $lhs_selector 1<<int(@set) ", 1<<int(@set), " rhs_selector $rhs_selector\n";
# print "lhs_set @lhs_set ";
# print "rhs_set @rhs_set\n";
my $lhs_set = join(' ', @lhs_set);
my $rhs_set = join(' ', @rhs_set);
# Spit out rule
my $lhs_support = $frequent_set{$lhs_set};
#my $rhs_support = $frequent_set{$rhs_set};
die "Couldn't find frequent set '$lhs_set'" if !defined($lhs_support);
#die "Couldn't find frequent set '$rhs_set'" if !defined($rhs_support);
# For rule A => B, support = T(AB), conf = T(AB) / T(A)
my $conf = $support / $lhs_support;
if ($conf >= $confidence_threshold) {
$num_rules++;
print RULES "$support ", sprintf("%.3f ", $conf),
int(@lhs_set), ' ', int(@rhs_set), ' ', int(@set), ' ',
"$lhs_set => $rhs_set\n";
}
}
}
close(RULES);
print STDERR "$num_rules rules\n" if $debug;
}
sub set_debug {
$debug = $_[0];
}
1;
=head1 DESCRIPTION
This module contains some functions to do association rule mining from
text files. This sounds obscure, but really measures beautifully
simple things through counting.
=head2 FREQUENT SETS
Frequent sets answer the question, "Which events occur together more
than N times?"
=head3 The detail
The 'transaction file' contains items in transactions. A set of items
has 'support' s if all the items occur together in at least s
transactions. (In many papers, support is a number between 0 and 1
representing the fraction of total transactions. I found the absolute
number itself more interesting, so I use that instead. Sorry for the
confusion.) For an itemset "A B C", the support is sometimes notated
"T(A B C)" (the number of 'T'ransactions).
A set of items is called a 'frequent set' if it has support at least
the given support threshold. Generating frequent set produces all
frequent sets, and some information about each set (e.g., its
support).
=head2 RULES
Association rules answer the (related) question, "When these events
occur, how often do those events also occur?"
=head3 The detail
A rule has a left-hand set of items and a right-hand set
of items. A rule "LHS => RHS" with a support s and 'confidence' c means
that the underlying frequent set (LHS + RHS) occured together in at
least s transactions, and for all the transactions LHS occurred in,
RHS also occured in at least the fraction c (a number from 0 to 1).
Generating rules produces all rules with support at least the given
support threshold, and confidence at least the given confidence
threshold. The confidence is sometimes notated "conf(LHS => RHS) =
T(LHS + RHS) / T(LHS)". There is also related data with each rule
(e.g., the size of its LHS and RHS, the support, the confidence,
etc.).
=head3 FREQUENT SETS AND ASSOCIATION RULES GENERALLY USEFUL
Although association rule mining is often described in commercial
terms like "market baskets" or "transactions" (collections of events)
and "items" (events), one can imagine events that make this sort of
counting useful across many domains. Events could be
=over
=item 0 stock market went down at time t
=item 0 patient had symptom X
=item 0 flower petal length was > 5mm
=back
For this reason, I believe counting frequent sets and looking at
association rules to be a fundamental tool of any data miner, someone
who is looking for patterns in pre-existing data, whether commercial
or not.
=head1 EXAMPLES
Given the following input file:
234 Orange
463 Strawberry
53 Apple
234 Banana
412 Peach
467 Pear
234 Pear
147 Pear
141 Orange
375 Orange
Generating frequent sets at support threshold 1 (a.k.a. 'at support 1')
produces three files:
The 1-sets:
1 Strawberry
1 Banana
1 Apple
3 Orange
1 Peach
3 Pear
The 2-sets:
1 Banana Orange
1 Banana Pear
1 Orange Pear
The 3-sets:
1 Banana Orange Pear
Generating the rules at support 1 produces the following:
1 0.333 1 1 2 Orange => Pear
1 0.333 1 1 2 Pear => Orange
1 1.000 1 2 3 Banana => Orange Pear
1 0.333 1 2 3 Orange => Banana Pear
1 1.000 2 1 3 Banana Orange => Pear
1 0.333 1 2 3 Pear => Banana Orange
1 1.000 2 1 3 Banana Pear => Orange
1 1.000 2 1 3 Orange Pear => Banana
1 1.000 1 1 2 Banana => Orange
1 0.333 1 1 2 Orange => Banana
1 1.000 1 1 2 Banana => Pear
1 0.333 1 1 2 Pear => Banana
Generating frequent sets at support 2 produces one file:
3 Orange
3 Pear
Generating rules at support 2 produces nothing.
Generating rules at support 1 and confidence 0.5 produces:
1 1.000 1 2 3 Banana => Orange Pear
1 1.000 2 1 3 Banana Orange => Pear
1 1.000 2 1 3 Banana Pear => Orange
1 1.000 2 1 3 Orange Pear => Banana
1 1.000 1 1 2 Banana => Orange
1 1.000 1 1 2 Banana => Pear
Note all the lower confidence rules are gone.
=head1 ALGORITHM
=head2 Generating frequent sets
Generating frequent sets is straight-up Apriori. See for example:
http://www.almaden.ibm.com/software/quest/Publications/papers/vldb94_rj.pdf
I have not optimized. It depends on having the transactions all in
memory. However, given that, it still might scale decently (millions
of transactions).
=head2 Generating rules
Generating rules is a very vanilla implementation. It requires
reading all the frequent sets into memory, which does not scale at
all. Given that, since computers have lots of memory these days, you
might still be able to get away with millions of frequent sets (which
is <<millions of transactions).
=head1 BUGS
There is an existing tool (written in C) to mine frequent sets I kept
running across:
http://fuzzy.cs.uni-magdeburg.de/~borgelt/software.html#assoc
I should check it out to see if it is easy or desirable to be
file-level compatible with it.
One could imagine wrapping it in Perl, but the Perl-C/C++ barrier is
where I have encountered all my troubles in the past, so I wouldn't
personally pursue that.
=head1 VERSION
This document describes Data::Mining::AssociationRules version 0.1.
=head1 AUTHOR
Dan Frankowski
dfrankow@winternet.com
http://www.winternet.com/~dfrankow
Hey, if you download this module, drop me an email! That's the fun
part of this whole open source thing.
=head1 LICENSE
This program is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
The full text of the license can be found in the LICENSE file included
in the distribution and available in the CPAN listing for
Data::Mining::AssociationRules (see www.cpan.org or search.cpan.org).
=head1 DISCLAIMER
To the maximum extent permitted by applicable law, the author of this
module disclaims all warranties, either express or implied, including
but not limited to implied warranties of merchantability and fitness
for a particular purpose, with regard to the software and the
accompanying documentation.
=cut