Data-Formula

 view release on metacpan or  search on metacpan

Build.PL  view on Meta::CPAN

    build_requires     => {'Test::Most'    => 0,},
    configure_requires => {'Module::Build' => '0.38'},
    dist_author        => 'Jozef Kutej <jkutej@cpan.org>',
    create_readme      => 1,
    add_to_cleanup     => ['Data-Formula-*'],
    meta_merge         => {
        resources => {
            repository => 'http://github.com/meon/Data-Formula',
            bugtracker => 'http://github.com/meon/Data-Formula/issues',
        },
        keywords => [qw/ formula calculation variables /],
    },
);
$build->create_build_script;

META.json  view on Meta::CPAN

{
   "abstract" : "formulas evaluation and calculation",
   "author" : [
      "Jozef Kutej <jkutej@cpan.org>"
   ],
   "dynamic_config" : 1,
   "generated_by" : "Module::Build version 0.4231",
   "keywords" : [
      "formula",
      "calculation",
      "variables"
   ],
   "license" : [
      "perl_5"
   ],
   "meta-spec" : {
      "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
      "version" : 2
   },

META.yml  view on Meta::CPAN

---
abstract: 'formulas evaluation and calculation'
author:
  - 'Jozef Kutej <jkutej@cpan.org>'
build_requires:
  Test::Most: '0'
configure_requires:
  Module::Build: '0.38'
dynamic_config: 1
generated_by: 'Module::Build version 0.4231, CPAN::Meta::Converter version 2.150010'
keywords:
  - formula
  - calculation
  - variables
license: perl
meta-spec:
  url: http://module-build.sourceforge.net/META-spec-v1.4.html
  version: '1.4'
name: Data-Formula
provides:
  Data::Formula:
    file: lib/Data/Formula.pm

README  view on Meta::CPAN

NAME
    Data::Formula - formulas evaluation and calculation

SYNOPSIS
        my $df = Data::Formula->new(
            formula   => 'var212 - var213 * var314 + var354',
        );
        my $val = $df->calculate(
            var212 => 5,
            var213 => 10,
            var314 => 7,
            var354 => 100
        );
        # 5-(10*7)+100

        my $df = Data::Formula->new(
            variables        => [qw( var212 var213 n274 n294 var314 var334 var354 var374 var394 )],
            formula          => 'var212 - var213 + var314 * (var354 + var394) - 10',
            on_error         => undef,
            on_missing_token => 0,
        );
        my $used_variables = $df->used_variables;
        # [ var212 var213 var314 var354 var394 ]

        my $val = $df->calculate(
            var212 => 5,
            var213 => 10,
            var314 => 2,
            var354 => 3,
            var394 => 9,
        );
        # 5-10+2*(3+9)-10

DESCRIPTION
    evaluate and calulate formulas with variables of the type var212 -
    var213 + var314 * (var354 + var394) - 10

ACCESSORS
  formula
    Formula for calculation. Required.

  on_error
    Sets what should "calculate()" return in case of an error. When division
    by zero happens or unknown tokens are found.

    Can be a scalar value, like for example 0 or "undef", or a code ref that
    will be executed with error message as argument.

    Optional, if not set "calculate()" will throw an exception in case of an
    error.

  on_missing_token
    Sets what should happen when there is a missing/unknown token found in
    formula.

    Can be a scalar value, like fixed number, or a code ref that will be
    executed with token name as argument.

    Optional, if not set "calculate()" will throw an exception with unknown
    tokens.

METHODS
  new()
    Object constructor.

         my $df = Data::Formula->new(
            formula   => 'var212 - var213 * var314 + var354',
         );

  used_variables()
    return array with variables used in formula

  calculate()
    Evaluate formula with values for variables, returns calculated value.

    Will throw expetion on division by zero of unknown variables, unless
    changes by "on_error" or "on_missing_token"

AUTHOR
    Jozef Kutej, "<jkutej at cpan.org>"

CONTRIBUTORS
    The following people have contributed to the File::is by committing
    their code, sending patches, reporting bugs, asking questions,

lib/Data/Formula.pm  view on Meta::CPAN

    '/' => {
        method => 'divide',
        calc   => 'divide',
        prio   => 50,
    },
    '(' => {method => 'bracket_left',},
    ')' => {method => 'bracket_right',},
);

has 'variables'      => (is => 'rw', isa => 'ArrayRef', default    => sub {[]});
has 'formula'        => (is => 'ro', isa => 'Str',      default    => sub {[]});
has '_tokens'        => (is => 'ro', isa => 'ArrayRef', lazy_build => 1,);
has '_rpn'           => (is => 'ro', isa => 'ArrayRef', lazy_build => 1,);
has '_op_indent'     => (is => 'rw', isa => 'Int',      default    => 0,);
has 'used_variables' => (is => 'ro', isa => 'ArrayRef', lazy_build => 1,);

has 'on_error' => (
    is        => 'rw',
    predicate => 'has_on_error',
    clearer   => 'clear_on_error',
);

lib/Data/Formula.pm  view on Meta::CPAN

    return [
        grep {$_ !~ m/^[0-9]+$/}
        grep {!$operators{$_}} @{$self->_tokens}
    ];
}

sub _build__tokens {
    my ($self) = @_;

    my @tokens;
    my $formula = $self->formula;
    $formula =~ s/\s//g;

    my $op_regexp               = join('', map {q{\\} . $_} keys %operators);
    my $op_regexp_with_variable = '^([^' . $op_regexp . ']*?)([' . $op_regexp . '])';
    while ($formula =~ m/$op_regexp_with_variable/) {
        my $variable = $1;
        my $operator = $2;
        push(@tokens, $variable) if length($variable);
        push(@tokens, $operator);
        $formula = substr($formula, length($variable . $operator));
    }
    if (length($formula)) {
        push(@tokens, $formula);
    }

    return [map {$_ =~ m/^[0-9]+$/ ? $_ + 0 : $_} @tokens];
}

sub _rpn_calc_plus {
    my ($self, $rpn) = @_;

    die 'not enough parameters left on stack'
        unless @$rpn > 1;

lib/Data/Formula.pm  view on Meta::CPAN

}

1;

__END__

=encoding utf8

=head1 NAME

Data::Formula - formulas evaluation and calculation

=head1 SYNOPSIS

    my $df = Data::Formula->new(
        formula   => 'var212 - var213 * var314 + var354',
    );
    my $val = $df->calculate(
        var212 => 5,
        var213 => 10,
        var314 => 7,
        var354 => 100
    );
    # 5-(10*7)+100

    my $df = Data::Formula->new(
        variables        => [qw( var212 var213 n274 n294 var314 var334 var354 var374 var394 )],
        formula          => 'var212 - var213 + var314 * (var354 + var394) - 10',
        on_error         => undef,
        on_missing_token => 0,
    );
    my $used_variables = $df->used_variables;
    # [ var212 var213 var314 var354 var394 ]

    my $val = $df->calculate(
        var212 => 5,
        var213 => 10,
        var314 => 2,
        var354 => 3,
        var394 => 9,
    );
    # 5-10+2*(3+9)-10

=head1 DESCRIPTION

evaluate and calulate formulas with variables of the type var212 - var213 + var314 * (var354 + var394) - 10

=head1 ACCESSORS

=head2 formula

Formula for calculation. Required.

=head2 on_error

Sets what should L</calculate()> return in case of an error. When division
by zero happens or unknown tokens are found.

Can be a scalar value, like for example C<0> or C<undef>, or a code ref
that will be executed with error message as argument.

Optional, if not set L</calculate()> will throw an exception in case of an error.

=head2 on_missing_token

Sets what should happen when there is a missing/unknown token found in
formula.

Can be a scalar value, like fixed number, or a code ref
that will be executed with token name as argument.

Optional, if not set L</calculate()> will throw an exception with unknown tokens.

=head1 METHODS

=head2 new()

Object constructor.

     my $df = Data::Formula->new(
        formula   => 'var212 - var213 * var314 + var354',
     );

=head2 used_variables() 

return array with variables used in formula

=head2 calculate()

Evaluate formula with values for variables, returns calculated value.

Will throw expetion on division by zero of unknown variables, unless
changes by L</on_error> or L</on_missing_token>

=head1 AUTHOR

Jozef Kutej, C<< <jkutej at cpan.org> >>

=head1 CONTRIBUTORS
 

t/01_Data-Formula.t  view on Meta::CPAN

use 5.010;
use utf8;

use Test::Most;

use_ok('Data::Formula') or die;

my $this_file = __FILE__;

SIMPLE_FORMULA: {
    my $formula = 'n212 - n213 + n314 + n354';
    note('testing formula: ' . $formula);
    my $df = Data::Formula->new(
        variables => [qw( n212 n213 n314 n354 )],
        formula   => $formula,
    );
    my $tokens = $df->_tokens;
    eq_or_diff($tokens, [qw( n212 - n213 + n314 + n354)], '_tokens()');

    my $used_variables = $df->used_variables;
    eq_or_diff($used_variables, [qw( n212 n213 n314 n354 )], 'used_variables()');

    my $rpn = $df->_rpn;
    eq_or_diff(
        $rpn,

t/01_Data-Formula.t  view on Meta::CPAN

    my $val = $df->calculate(
        n212 => 5,
        n213 => 10,
        n314 => 7,
        n354 => 100
    );
    is($val, (5 - 10 + 7 + 100), 'calculate()');
}

SIMPLE_FORMULA2: {
    my $formula = 'n212 - (n213 + n314 + n354)';
    note('testing formula: ' . $formula);
    my $df = Data::Formula->new(formula => $formula,);

    my $val = $df->calculate(
        n212 => 5,
        n213 => 2,
        n314 => 3,
        n354 => 6,
    );
    is($val, (5 - (2 + 3 + 6)), 'calculate()');

    my $rpn = $df->_rpn;

t/01_Data-Formula.t  view on Meta::CPAN

            {'name' => '+', calc => 'plus', method => 'plus', prio => 110,},
            'n354',
            {'name' => '+', calc => 'plus',  method => 'plus',  prio => 110,},
            {'name' => '-', calc => 'minus', method => 'minus', prio => 10,},
        ],
        '_rpn()'
    );
}

MULTIPLICATION_FORMULA: {
    my $formula = 'n212 - n213 * n314 + n354';
    note('testing formula: ' . $formula);
    my $df = Data::Formula->new(formula => $formula,);

    my $val = $df->calculate(
        n212 => 5,
        n213 => 10,
        n314 => 7,
        n354 => 100
    );
    is($val, (5 - (10 * 7) + 100), 'calculate()');

    my $tokens = $df->_tokens;

t/01_Data-Formula.t  view on Meta::CPAN

            {'name' => '*', calc => 'multiply', method => 'multiply', prio => 50,},
            {'name' => '-', calc => 'minus',    method => 'minus',    prio => 10,},
            'n354',
            {'name' => '+', calc => 'plus', method => 'plus', prio => 10,},
        ],
        '_rpn()'
    );
}

LONGER_FORMULA: {
    my $formula = 'n212 - n213 + n314 * (n354 + n394) - 10';
    note('testing formula: ' . $formula);
    my $df = Data::Formula->new(
        variables => [qw( n212 n213 n274 n294 n314 n334 n354 n374 n394 )],
        formula   => $formula,
    );
    my $tokens = $df->_tokens;
    eq_or_diff($tokens, [qw( n212 - n213 + n314 * ( n354 + n394 ) - 10 )], '_tokens()');

    my $used_variables = $df->used_variables;
    eq_or_diff($used_variables, [qw( n212 n213 n314 n354 n394 )], 'used_variables()');

    my $rpn = $df->_rpn;
    eq_or_diff(
        $rpn,

t/01_Data-Formula.t  view on Meta::CPAN

        n212 => 5,
        n213 => 10,
        n314 => 2,
        n354 => 3,
        n394 => 9,
    );
    is($val, (5 - 10 + (2 * (3 + 9)) - 10), 'calculate()');
}

DIVISION_FORMULA: {
    my $formula = 'n45 / n100';
    note('testing formula: ' . $formula);
    my $df = Data::Formula->new(formula => $formula,);

    my $val = $df->calculate(
        n100 => 100,
        n45  => 45,
    );
    is($val, (45 / 100), 'calculate()');

    my $tokens = $df->_tokens;
    eq_or_diff($tokens, [qw( n45 / n100 )], '_tokens()');

    my $rpn = $df->_rpn;
    eq_or_diff($rpn,
        ['n45', 'n100', {'name' => '/', calc => 'divide', method => 'divide', prio => 50,},],
        '_rpn()');
}

DIVISION_BY_ZERO_FORMULA: {
    my $formula = 'n100 / ( n10 - n10 )';
    note('testing formula: ' . $formula);
    my $df = Data::Formula->new(
        formula  => $formula,
        on_error => 0,
    );

    my $val = $df->calculate(
        n100 => 100,
        n10  => 10,
    );
    is($val, 0, 'calculate()');
}

DIVISION_BY_ZERO_FORMULA_EXCEPTION: {
    my $formula = 'n100 / ( n10 - n10 )';
    note('testing formula: ' . $formula);
    my $df = Data::Formula->new(formula => $formula,);

    throws_ok(
        sub {
            my $val = $df->calculate(
                n100 => 100,
                n10  => 10,
            );
        },
        qr/division by zero.+$this_file/,
        'calculate() -> division by zero'
    );
}

DIVISION_BY_ZERO_FORMULA_CODE: {
    my $formula = 'n100 / ( n10 - n10 )';
    note('testing formula: ' . $formula);
    my $df = Data::Formula->new(
        formula  => $formula,
        on_error => sub {$_[0]},
    );

    my $val = $df->calculate(
        n100 => 100,
        n10  => 10,
    );
    is($val, 'Illegal division by zero', 'calculate() -> code ref result');
}

DIVISION_BY_UNDEF_FORMULA: {
    my $formula = 'n100 / nope ';
    note('testing formula: ' . $formula);
    my $df = Data::Formula->new(
        formula  => $formula,
        on_error => 0,
    );

    my $val = $df->calculate(n100 => 100,);
    is($val, 0, 'calculate()');
}

DIVISION_BY_UNDEF_FORMULA_UNDEF: {
    my $formula = 'n100 / nope ';
    note('testing formula: ' . $formula);
    my $df = Data::Formula->new(
        formula  => $formula,
        on_error => undef,
    );

    my $val = $df->calculate(n100 => 100,);
    is($val, undef, 'calculate() -> undef');
}

DIVISION_BY_UNDEF_FORMULA_EXCEPTION: {
    my $formula = 'n100 / nope ';
    note('testing formula: ' . $formula);
    my $df = Data::Formula->new(formula => $formula,);

    throws_ok(
        sub {
            my $val = $df->calculate(n100 => 100,);
        },
        qr/"nope" is not a literal number, not a valid token.+$this_file/,
        'calculate() -> division by zero'
    );
}

DIVISION_BY_UNDEF_FORMULA_DEFAULT: {
    my $formula = 'n100 / nope ';
    note('testing formula: ' . $formula);
    my $df = Data::Formula->new(
        formula          => $formula,
        on_missing_token => 1,
    );

    my $val = $df->calculate(n100 => 100,);
    is($val, 100, 'calculate() -> default value for missing token');
}

PERCENT_FORMULA: {
    my $formula = '100 * n45 / n100 ';
    note('testing formula: ' . $formula);
    my $df = Data::Formula->new(formula => $formula,);

    my $val = $df->calculate(
        n100 => 100,
        n45  => 45,
    );
    is($val, 45, 'calculate()');
}

done_testing();



( run in 0.649 second using v1.01-cache-2.11-cpan-3cd7ad12f66 )