File Coverage

blib/lib/Simulation/Sensitivity.pm

Criterion	Covered	Total	%
statement	44	44	100.0
branch	4	4	100.0
condition			n/a
subroutine	10	10	100.0
pod	4	4	100.0
total	62	62	100.0

package Simulation::Sensitivity;
use strict;
use warnings;
# ABSTRACT: A general-purpose sensitivity analysis tool for user-supplied calculations and parameters
our $VERSION = '0.12'; # VERSION

# Required modules
use Carp;
use Params::Validate ':all';

# ISA
use base qw( Class::Accessor::Fast );

#--------------------------------------------------------------------------#
# main pod documentation #####
#--------------------------------------------------------------------------#


#--------------------------------------------------------------------------#
# new()
#--------------------------------------------------------------------------#


{
    my $param_spec = {
        calculation => { type => CODEREF },
        parameters  => { type => HASHREF },
        delta       => { type => SCALAR }
    };

    __PACKAGE__->mk_accessors( keys %$param_spec );

    sub new {
        my $class  = shift;
        my %params = validate( @_, $param_spec );
        my $self   = bless( {%params}, $class );
        return $self;
    }

}


#--------------------------------------------------------------------------#
# base()
#--------------------------------------------------------------------------#


sub base {
    my ($self) = @_;
    return $self->calculation->( { %{ $self->parameters } } );
}

#--------------------------------------------------------------------------#
# run()
#--------------------------------------------------------------------------#


sub run {
    my ($self) = @_;
    my $results;

    for my $key ( keys %{ $self->parameters } ) {
        $results->{$key} = {};
        for my $mult ( 1, -1 ) {
            my $p = { %{ $self->parameters } };
            $p->{$key} = ( 1 + $mult * $self->delta ) * $self->parameters->{$key};
            $results->{$key}->{ $self->_case($mult) } =
              $self->calculation->($p);
        }
    }
    return $results;
}

#--------------------------------------------------------------------------#
# _case ($mult, $result, $base)
#
# private helper function to turn a +/-1 into a case label using the delta
#--------------------------------------------------------------------------#

sub _case {
    my ( $self, $mult ) = @_;
    return ( ( $mult == 1 ) ? "+" : "-" ) . ( $self->delta * 100 ) . "%";
}

#--------------------------------------------------------------------------#
# text_report()
#--------------------------------------------------------------------------#


sub text_report {
    my ( $self, $results ) = @_;
    my $base = $self->base;
    croak "Simulation base case is zero/undefined.  Cannot generate report."
      unless $base;
    my $report =
      sprintf( "%12s %9s %9s\n", "Parameter", $self->_case(1), $self->_case(-1) );
    $report .= sprintf( "-" x 36 . "\n" );
    for my $param ( sort keys %$results ) {
        my $cases = $results->{$param};
        $report .= sprintf(
            "%12s %+9.2f%% %+9.2f%%\n",
            $param,
            ( $cases->{ $self->_case(1) } / $base - 1 ) * 100,
            ( $cases->{ $self->_case(-1) } / $base - 1 ) * 100,
        );
    }
    return $report;
}

1;

__END__