File Coverage

blib/lib/Data/Mining/Apriori.pm

Criterion	Covered	Total	%
statement	19	287	6.6
branch	0	130	0.0
condition	1	45	2.2
subroutine	6	16	37.5
pod	7	11	63.6
total	33	489	6.7

package Data::Mining::Apriori;

use 5.010001;
use strict;
use warnings;
use Algorithm::Combinatorics qw(subsets variations);
no if $] >= 5.017011, warnings => 'experimental::smartmatch';

our $VERSION = 0.17;

my$self;

$" = ', ';
$| = 1;
$SIG{'INT'} = \&stop;

sub new{
	my $type = shift;
	my $class = ref($type)||$type;
	$self = {
		totalTransactions => 0,
		metrics => {
			minSupport => 0.01,
			minConfidence => 0.10,
			minLift => undef,
			minLeverage => undef,
			minConviction => undef,
			minCoverage => undef,
			minCorrelation => undef,
			minCosine => undef,
			minLaplace => undef,
			minJaccard => undef
		},
		precision => 3,
		output => undef,
		pathOutputFiles => "",
		messages => undef,
		keyItemsDescription => undef,
		keyItemsTransactions => undef,
		limitRules => undef,
		limitSubsets => undef,
		numberSubsets => 0,
		frequentItemset => [],
		associationRules => undef,
		implications => undef,
		largeItemsetLength => 2,
		rule => 0
	};
	bless($self,$class);
	return $self;
}

sub validate_data{
	(defined $self->{keyItemsDescription})
		or die('Error: $apriori->{keyItemsDescription} is not defined!');
	(defined $self->{keyItemsTransactions})
		or die('Error: $apriori->{keyItemsTransactions} is not defined!');
	(defined $self->{metrics}{minSupport})
		or die('Error: $apriori->{metrics}{minSupport} is not defined!');
	(defined $self->{metrics}{minConfidence})
		or die('Error: $apriori->{metrics}{minConfidence} is not defined!');
}

sub insert_key_items_transaction{
	(scalar(@_)==2)
		or die('Error: $apriori->insert_key_items_transaction(\@items) missing parameter key items to array reference!');
	(ref($_[1]) eq "ARRAY")
		or die('Error: $apriori->insert_key_items_transaction(\@items) parameter key items is not an array reference!');
	my@items=sort(@{$_[1]});
	my @itemsets=subsets(\@items);
	foreach my$itemset(@itemsets){
		$self->{keyItemsTransactions}{"@{$itemset}"}++;
	}
	$self->{totalTransactions}++;
}

sub input_data_file{
	(scalar(@_)==3)
		or die('Error: $apriori->input_data_file("datafile.txt",",") missing parameters path to data file and/or item separator!');
	my$file=$_[1];
	my$separator=$_[2];
	(-e $file)
		or die("Error: the file \"$file\" does not exists!");
	(-r $file)
		or die("Error: the file \"$file\" is not readable!");
	(-T $file)
		or die("Error: the file \"$file\" is not a text file!");
	open(FILE,"<$file")
		or die("Error: $!");
	while(my$line=){
		$line=~s/\r\n|\n//;
		my@items=split($separator,$line);
		if(scalar(@items)>=2){
			$self->insert_key_items_transaction(\@items);
		}
	}
	close(FILE);
}

sub quantity_possible_rules{
	$self->validate_data;
	return ((3**scalar(keys(%{$self->{keyItemsDescription}})))-(2**(scalar(keys(%{$self->{keyItemsDescription}}))+1))+1);
}

sub generate_rules{
	$self->validate_data;
	if($self->{messages}){
		print "\n${\scalar(keys(%{$self->{keyItemsDescription}}))} items, ${\$self->quantity_possible_rules} possible rules";
	}
	my @largeItemsetLengthOne = grep{(($self->{keyItemsTransactions}{$_}/$self->{totalTransactions})*100)>=$self->{metrics}{minSupport}}keys(%{$self->{keyItemsDescription}});
	$self->association_rules(\@largeItemsetLengthOne);
}

sub association_rules{
	my @largeItemset = @{$_[1]};
	my @variations = variations(\@largeItemset,$self->{largeItemsetLength});
	my @frequentItemset;
	if($self->{messages}){
		print "\nLarge itemset of length $self->{largeItemsetLength}, ${\scalar(@largeItemset)} items ";
		print "\nProcessing ...";
	}
	VARIATIONS:
	foreach my$variation(@variations){
		my@candidateItemset=@{$variation};
		my@antecedent;
		my@consequent;
		for(my$antecedentLength=0;$antecedentLength<$#candidateItemset;$antecedentLength++){
			push@antecedent,$candidateItemset[$antecedentLength];
			@consequent=();
			for(my$consequentLength=($antecedentLength+1);$consequentLength<=$#candidateItemset;$consequentLength++){
				push@consequent,$candidateItemset[$consequentLength];
			}
			@antecedent=sort@antecedent;
			@consequent=sort@consequent;
			next if("@consequent"~~@{$self->{implications}{"@antecedent"}});
			last VARIATIONS if(defined $self->{limitSubsets} && $self->{numberSubsets} == $self->{limitSubsets});
			$self->{numberSubsets}++;
			push @{$self->{implications}{"@antecedent"}},"@consequent";
			my@implication;
			push@implication,@antecedent,@consequent;
			@implication=sort(@implication);
			next unless $self->{keyItemsTransactions}{"@antecedent"};
			my$supportAntecedent=($self->{keyItemsTransactions}{"@antecedent"}/$self->{totalTransactions});
			next unless $self->{keyItemsTransactions}{"@implication"};
			my$supportConsequent=($self->{keyItemsTransactions}{"@implication"}/$self->{totalTransactions});
			my $support = $supportConsequent;
			next if($support < $self->{metrics}{minSupport});
			my $confidence = ($supportConsequent/$supportAntecedent);
			next if(defined $self->{metrics}{minConfidence} && $confidence < $self->{metrics}{minConfidence});
			my $lift = ($support/($supportAntecedent*$supportConsequent));
			next if(defined $self->{metrics}{minLift} && $lift < $self->{metrics}{minLift});
			my $leverage = ($support-($supportAntecedent*$supportConsequent));
			next if(defined $self->{metrics}{minLeverage} && $leverage < $self->{metrics}{minLeverage});
			my $conviction = ((1-$supportConsequent)==0)?"NaN":((1-$confidence)==0)?"NaN":((1-$supportConsequent)/(1-$confidence));
			next if(defined $self->{metrics}{minConviction} && $conviction < $self->{metrics}{minConviction});
			my $coverage = $supportAntecedent;
			next if(defined $self->{metrics}{minCoverage} && $coverage < $self->{metrics}{minCoverage});
			my $correlation = (($support-($supportAntecedent*$supportConsequent))/sqrt($supportAntecedent*(1-$supportAntecedent)*$supportConsequent*(1-$supportConsequent)));
			next if(defined $self->{metrics}{minCorrelation} && $correlation < $self->{metrics}{minCorrelation});
			my $cosine = ($support/sqrt($supportAntecedent*$supportConsequent));
			next if(defined $self->{metrics}{minCosine} && $cosine < $self->{metrics}{minCosine});
			my $laplace = (($support+1)/($supportAntecedent+2));
			next if(defined $self->{metrics}{minLaplace} && $laplace < $self->{metrics}{minLaplace});
			my $jaccard = ($support/($supportAntecedent+$supportConsequent-$support));
			next if(defined $self->{metrics}{minJaccard} && $jaccard < $self->{metrics}{minJaccard});
			$self->{rule}++;
			$support = sprintf("%.$self->{precision}f", $support);
			$confidence = sprintf("%.$self->{precision}f", $confidence);
			$lift = sprintf("%.$self->{precision}f", $lift);
			$leverage = sprintf("%.$self->{precision}f", $leverage);
			$conviction = sprintf("%.$self->{precision}f", $conviction)if($conviction ne "NaN");
			$coverage = sprintf("%.$self->{precision}f", $coverage);
			$correlation = sprintf("%.$self->{precision}f", $correlation);
			$cosine = sprintf("%.$self->{precision}f", $cosine);
			$laplace = sprintf("%.$self->{precision}f", $laplace);
			$jaccard = sprintf("%.$self->{precision}f", $jaccard);
			$self->{associationRules}{$self->{rule}} = {
				implication => "{ @antecedent } => { @consequent }",
				support => $support,
				confidence => $confidence,
				lift => $lift,
				leverage => $leverage,
				conviction => $conviction,
				coverage => $coverage,
				correlation => $correlation,
				cosine => $cosine,
				laplace => $laplace,
				jaccard => $jaccard,
				items => [@antecedent, @consequent]
			};
			my@items=grep{!($_~~@frequentItemset)}@implication;
			push@frequentItemset,@items;
			last VARIATIONS if(defined $self->{limitRules} && $self->{rule} == $self->{limitRules});
		}
	}
	if($self->{messages}){
		print "\nFrequent itemset: { @frequentItemset }, ${\scalar(@frequentItemset)} items ";
	}
	if(defined $self->{associationRules}){
		@{$self->{frequentItemset}}=@frequentItemset;
		$self->output;
	}
	return if((defined $self->{limitRules} && $self->{rule} == $self->{limitRules})
				||(defined $self->{limitSubsets} && $self->{numberSubsets} == $self->{limitSubsets}));
	if(scalar(@frequentItemset)>=($self->{largeItemsetLength}+1)){
		$self->{largeItemsetLength}++;
		$self->{associationRules} = undef;
		$self->association_rules(\@frequentItemset);
	}
}

sub stop{
	if($self->{messages}){
		print "\nStopping ...";
		$self->output if $self->{associationRules};
		print "\nExit? (Y/N): ";
		my $answer = ;
		chomp($answer);
		if($answer =~ /^y$/i){
			exit;
		}
		else{
			print "Processing ...";
		}
	}
	else{
		$self->output if $self->{associationRules};
		exit;
	}
}

sub output{
	if($self->{output}){
		if($self->{output}==1){
			$self->file;
		}
		elsif($self->{output}==2){
			$self->excel;
		}
	}
}

sub file{
	if($self->{messages}){
		print "\nExporting to file $self->{pathOutputFiles}output_large_itemset_length_$self->{largeItemsetLength}.txt ...";
	}
	open(FILE,">$self->{pathOutputFiles}output_large_itemset_length_$self->{largeItemsetLength}.txt")
		or die("\nError: $self->{pathOutputFiles}output_large_itemset_length_$self->{largeItemsetLength}.txt $!");
	print FILE "Rules\tSupport\tConfidence";
	my@headings=('Lift', 'Leverage', 'Conviction', 'Coverage', 'Correlation', 'Cosine', 'Laplace', 'Jaccard');
	my@metrics;
	foreach my$metric(@headings){
		push@metrics,$metric if defined $self->{metrics}{"min$metric"};
	}
	foreach my$metric(@metrics){
		print FILE "\t$metric";
	}
	print FILE "\n";
	foreach my$rule(sort{$a<=>$b}keys(%{$self->{associationRules}})){
		$self->{associationRules}{$rule}{support}=~s/\./,/;
		$self->{associationRules}{$rule}{confidence}=~s/\./,/;
		foreach my$metric(@metrics){
			$self->{associationRules}{$rule}{lc$metric}=~s/\./,/;
		}
		print FILE "R$rule\t$self->{associationRules}{$rule}{support}\t$self->{associationRules}{$rule}{confidence}";
		foreach my$metric(@metrics){
			print FILE "\t$self->{associationRules}{$rule}{${\lc$metric}}";
		}
		print FILE "\n";
	}
	print FILE "\n";
	foreach my$rule(sort{$a<=>$b}keys(%{$self->{associationRules}})){
		print FILE "Rule R$rule: $self->{associationRules}{$rule}{implication}\n";
		print FILE "Support: $self->{associationRules}{$rule}{support}\n";
		print FILE "Confidence: $self->{associationRules}{$rule}{confidence}\n";
		foreach my$metric(@metrics){
			print FILE "$metric: $self->{associationRules}{$rule}{${\lc$metric}}\n";
		}
		print FILE "Items:\n";
		foreach my$item(@{$self->{associationRules}{$rule}{items}}){
			print FILE "$item $self->{keyItemsDescription}{$item}\n";
		}
		print FILE "\n";
	}
	print FILE "Frequent itemset: { @{$self->{frequentItemset}} }\n";
	print FILE "Items:\n";
	foreach my$item(@{$self->{frequentItemset}}){
		print FILE "$item $self->{keyItemsDescription}{$item}\n";
	}
	close(FILE);
}

sub excel{
	require Excel::Writer::XLSX;
	if($self->{messages}){
		print "\nExporting to excel $self->{pathOutputFiles}output_large_itemset_length_$self->{largeItemsetLength}.xlsx ...";
	}
	my $workbook  = Excel::Writer::XLSX->new("$self->{pathOutputFiles}output_large_itemset_length_$self->{largeItemsetLength}.xlsx")
		or die("\nError: $self->{pathOutputFiles}output_large_itemset_length_$self->{largeItemsetLength}.xlsx $!");
	my $worksheet = $workbook->add_worksheet();
	my $bold = $workbook->add_format(bold => 1);
	my $headings = ['Rules', 'Support', 'Confidence'];
	my@metrics=('Lift', 'Leverage', 'Conviction', 'Coverage', 'Correlation', 'Cosine', 'Laplace', 'Jaccard');
	foreach my$metric(@metrics){
		push@{$headings},$metric if defined $self->{metrics}{"min$metric"};
	}
	@metrics=@{$headings}[3..$#{$headings}];
	my(@rules,@support,@confidence,@lift,@leverage,@conviction,@coverage,@correlation,@cosine,@laplace,@jaccard);
	foreach my$rule(sort{$a<=>$b}keys(%{$self->{associationRules}})){
		push @rules,"R$rule";
		push @support,$self->{associationRules}{$rule}{support};
		push @confidence,$self->{associationRules}{$rule}{confidence};
		push @lift,$self->{associationRules}{$rule}{lift} if defined $self->{metrics}{minLift};
		push @leverage,$self->{associationRules}{$rule}{leverage} if defined $self->{metrics}{minLeverage};
		push @conviction,$self->{associationRules}{$rule}{conviction} if defined $self->{metrics}{minConviction};
		push @coverage,$self->{associationRules}{$rule}{coverage} if defined $self->{metrics}{minCoverage};
		push @correlation,$self->{associationRules}{$rule}{correlation} if defined $self->{metrics}{minCorrelation};
		push @cosine,$self->{associationRules}{$rule}{cosine} if defined $self->{metrics}{minCosine};
		push @laplace,$self->{associationRules}{$rule}{laplace} if defined $self->{metrics}{minLaplace};
		push @jaccard,$self->{associationRules}{$rule}{jaccard} if defined $self->{metrics}{minJaccard};
	}
	my$line=(scalar(@rules)+1);
	my@data=(\@rules,\@support,\@confidence);
	push @data,\@lift if defined $self->{metrics}{minLift};
	push @data,\@leverage if defined $self->{metrics}{minLeverage};
	push @data,\@conviction if defined $self->{metrics}{minConviction};
	push @data,\@coverage if defined $self->{metrics}{minCoverage};
	push @data,\@correlation if defined $self->{metrics}{minCorrelation};
	push @data,\@cosine if defined $self->{metrics}{minCosine};
	push @data,\@laplace if defined $self->{metrics}{minLaplace};
	push @data,\@jaccard if defined $self->{metrics}{minJaccard};
	$worksheet->write('A1', $headings, $bold);
	$worksheet->write('A2', \@data);
	my$chart=$workbook->add_chart(type =>'column', embedded=>1);
	my@columns=('B'..'M');
	my$i=0;
	$chart->add_series(
		name       => 'Support',
		categories => '=Sheet1!$A$2:$A$'.$line,
		values     => '=Sheet1!$'.$columns[$i].'$2:$'.$columns[$i].'$'.$line,
	);
	$i++;
	$chart->add_series(
		name       => 'Confidence',
		categories => '=Sheet1!$A$2:$A$'.$line,
		values     => '=Sheet1!$'.$columns[$i].'$2:$'.$columns[$i].'$'.$line,
	);
	foreach my$metric(@metrics){
		$i++;
		$chart->add_series(
			name       => $metric,
			categories => '=Sheet1!$A$2:$A$'.$line,
			values     => '=Sheet1!$'.$columns[$i].'$2:$'.$columns[$i].'$'.$line,
		);
	}
	$worksheet->insert_chart($columns[($i+2)].'2', $chart);
	$line+=2;
	my $urlFormat = $workbook->add_format(
	    color     => 'blue',
	);
	my$url=2;
	foreach my$rule(sort{$a<=>$b}keys(%{$self->{associationRules}})){
		$worksheet->write_url("A$line","internal:Sheet1!A$url",$urlFormat,"<");
		$line++;
		$worksheet->write_url("A$url","internal:Sheet1!A$line",$urlFormat,"R$rule");
		$worksheet->write("A$line","Rule R$rule: $self->{associationRules}{$rule}{implication}");
		$line++;
		$worksheet->write("A$line","Support: $self->{associationRules}{$rule}{support}");
		$line++;
		$worksheet->write("A$line","Confidence: $self->{associationRules}{$rule}{confidence}");
		$line++;
		foreach my$metric(@metrics){
			$worksheet->write("A$line","$metric: $self->{associationRules}{$rule}{${\lc$metric}}");
			$line++;
		}
		$worksheet->write("A$line","Items:");
		$line++;
		foreach my$item(@{$self->{associationRules}{$rule}{items}}){
			$worksheet->write("A$line","$item $self->{keyItemsDescription}{$item}");
			$line++;
		}
		$line++;
		$url++;
	}
	$worksheet->write("A$line","Frequent itemset: { @{$self->{frequentItemset}} }");
	$line++;
	$worksheet->write("A$line","Items:");
	$line++;
	foreach my$item(@{$self->{frequentItemset}}){
		$worksheet->write("A$line","$item $self->{keyItemsDescription}{$item}");
		$line++;
	}
	$workbook->close;
}

return 1;
__END__