File Coverage

blib/lib/Data/BenchmarkResults.pm

Criterion	Covered	Total	%
statement	15	162	9.2
branch	0	16	0.0
condition	0	6	0.0
subroutine	5	16	31.2
pod	0	11	0.0
total	20	211	9.4

package Data::BenchmarkResults;

require 5.005_62;
use strict;
use warnings;

use Statistics::Lite qw(:all);

require Exporter;

our @ISA = qw(Exporter);

# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.

# This allows declaration	use Data::BenchmarkResults ':all';
# If you do not need this, moving things directly into @EXPORT or @EXPORT_OK
# will save memory.
our %EXPORT_TAGS = ( 'all' => [ qw(

) ] );

our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );

our @EXPORT = qw(

);
our $VERSION = '0.01';


# Preloaded methods go here.

sub new
{
	my $class = shift;
	my $self = {};
	bless($self,$class);
	return $self;
}

sub add_result_set
{
	my $self = shift;
	my $test_name = shift;
	my $file_name = shift;
	my $result_set = shift;
	push (@{$self->{test_results}{$test_name}{$file_name}},$result_set);
}

sub add_computed_set
{
	my $self = shift;
	my $test_name = shift;
	my $result_set = shift;
	push (@{$self->{computed_results}{$test_name}},@$result_set);

}


sub process_result_set
{
	my $self = shift;
	my $test_name = shift;
	my $process = shift;
	my $tossextremes = shift;

	my @computed = ();

	my @runs = values %{$self->{test_results}{$test_name}};


	for my $row (0 .. $#{$runs[0]})

	{
		for my $column (0 .. $#{$runs[0][$row]})
		{ # iterate through the columns of each row

		my @rowvalues = ();

		for my $run (0 .. $#runs)
		{
			my $cleaned = $runs[$run][$row][$column];
			$cleaned =~ s/^\s+//;
			$cleaned =~ s/\s+$//;
			push @rowvalues, $cleaned;
		}

			if ($tossextremes == 1)

				{
				(my $max, my $maxlocation) = Max_with_Index(\@rowvalues);
				splice(@rowvalues,$maxlocation,1);
				(my $min, my $minlocation) = Min_with_Index(\@rowvalues);
				splice(@rowvalues,$minlocation,1);
				}

			if ($rowvalues[0] =~ /^\d+$/)
				{
						no strict 'refs';
						$computed[$row][$column] = &$process(@rowvalues);
				}
			else {$computed[$row][$column] = $rowvalues[0];}
		}

	}
	$self->add_computed_set($test_name,\@computed);
	return @computed;
}


sub process_all_result_sets
{
	my $self = shift;
	my $process = shift;
	my $tossextremes = shift;


	foreach my $test_name (keys %{$self->{test_results}})
	{
	my @computed = ();
	my @runs = values %{$self->{test_results}{$test_name}};


	for my $row (0 .. $#{$runs[0]})

	{
		for my $column (0 .. $#{$runs[0][$row]})
		{ # iterate through the columns of each row

		my @rowvalues = ();

		for my $run (0 .. $#runs)
		{
			my $cleaned = $runs[$run][$row][$column];
			$cleaned =~ s/^\s+//;
			$cleaned =~ s/\s+$//;
			push @rowvalues, $cleaned;
		}



			if ($rowvalues[0] =~ /^\d+$/)
				{
				if ($tossextremes == 1)
						{
						(my $max, my $maxlocation) = Max_with_Index(\@rowvalues);
						splice(@rowvalues,$maxlocation,1);
						(my $min, my $minlocation) = Min_with_Index(\@rowvalues);
						splice(@rowvalues,$minlocation,1);
						}
					no strict 'refs';
					$computed[$row][$column] = &$process(@rowvalues);
				}
			else {$computed[$row][$column] = $rowvalues[0];}
		}

	}
	$self->add_computed_set($test_name,\@computed);
	}
	return 1;
}

sub compare_result_set
{
	my $self = shift;
	my $second_results = shift;
	my $test_name = shift;

	my @runs = ();
	my @computed = ();

	push (@runs,$self->{computed_results}{$test_name});
	push (@runs,$second_results->{computed_results}{$test_name});

	for my $row (0 .. $#{$runs[0]})

	{
		for my $column (0 .. $#{$runs[0][$row]})
		{ # iterate through the columns of each row

		my @rowvalues = ();

		for my $run (0 .. $#runs)
		{
			push @rowvalues, $runs[$run][$row][$column];
		}
			if (($rowvalues[0] =~ /^\d+\.*\d*$/) && ($rowvalues[0] >0)){ $computed[$row][$column] = Percentage_difference($rowvalues[0],$rowvalues[1]);}
			else
			{
			$computed[$row][$column] = $rowvalues[0];
			}

		}

	}

	return \@computed;
}

sub compare_all_result_sets
{
	my $self = shift;
	my $second_results = shift;
	my $test_name = shift;

	my %compared_tests = ();

	foreach my $test_name (keys %{$self->{test_results}})
	{
	my @runs = ();
	my @computed = ();

	push (@runs,$self->{computed_results}{$test_name});
	push (@runs,$second_results->{computed_results}{$test_name});

	for my $row (0 .. $#{$runs[0]})

		{
			for my $column (0 .. $#{$runs[0][$row]})
			{ # iterate through the columns of each row

			my @rowvalues = ();

			for my $run (0 .. $#runs)
			{
				push @rowvalues, $runs[$run][$row][$column];
			}
				if (($rowvalues[0] =~ /^\d+\.*\d*$/) && ($rowvalues[0] >0)){ $computed[$row][$column] = Percentage_difference($rowvalues[0],$rowvalues[1]);}
				else
				{
				$computed[$row][$column] = $rowvalues[0];
				}

			}

		}
	$compared_tests{$test_name} = \@computed;
	}

	return \%compared_tests;
}

sub print_calculated_sets
{
	my $self = shift;

	for my $key (keys %{$self->{computed_results}})
		{
		print "Test=$key\n";
		for my $i (0 .. $#{$self->{computed_results}{$key}})
			{
			for my $j (0 .. $#{$self->{computed_results}{$key}->[$i]})
				{print "$self->{computed_results}{$key}->[$i][$j]\t";}
			print "\n";
			}
		}
	print "\n";
}

sub Max_with_Index {
    # takes an array ref - returns the max

    my $list = shift;
    my $max = $list->[0];
    my $ind = 0; # new
    my $i   = 0; # new
    foreach (@$list) {
        if ($_ > $max) {
           $max = $_;
           $ind = $i; # new
        }
        $i++; # new
    }

    return($max, $ind);
}

sub Min_with_Index {
    # takes an array ref - returns the min

    my $list = shift;
    my $min = $list->[0];
    my $ind = 0; # new
    my $i   = 0; # new
    foreach (@$list) {
        if ($_ < $min) {
           $min = $_;
           $ind = $i; # new
        }
        $i++; # new
    }

    return($min, $ind);
}

sub Percentage_difference #Takes two values and returns the relative percentage difference of the second from the first
{
my $first = shift;
my $second = shift;

my $absolute_change = $first-$second;
my $relative_change = $absolute_change/$second;
my $percentage = $relative_change * 100;
return $percentage;
}

1;
__END__