File Coverage

blib/lib/Game/PseudoRand.pm

Criterion	Covered	Total	%
statement	88	92	95.6
branch	36	36	100.0
condition	64	74	86.4
subroutine	18	20	90.0
pod	4	4	100.0
total	210	226	92.9

# -*- Perl -*-
#
# returns Pseudo Random Distribution random functions

package Game::PseudoRand;

use 5.10.0;
use strict;
use warnings;
use Carp qw(croak);

require Exporter;
our @ISA       = qw(Exporter);
our @EXPORT_OK = qw(prd_bistep prd_step prd_bitable prd_table);

our $VERSION = '0.03';

sub HIT ()  { 1 }
sub MISS () { 0 }

sub prd_bistep {
    my %param = @_;
    croak "need start step_hit step_miss values"
      unless exists $param{start}
      and exists $param{step_hit}
      and exists $param{step_miss};
    croak "rand must be a code ref"
      if defined $param{rand} and ref $param{rand} ne 'CODE';
    my $odds = $param{start};
    my $rand = $param{rand} // sub { CORE::rand };
    (   sub {
            if   ( &$rand <= $odds ) { $odds += $param{step_hit};  HIT }
            else                     { $odds += $param{step_miss}; MISS }
        },
        sub { $odds = $param{start} }
    );
}

sub prd_step {
    my %param = @_;
    croak "requires start and step values"
      unless exists $param{start}
      and exists $param{step};
    croak "rand must be a code ref"
      if defined $param{rand} and ref $param{rand} ne 'CODE';
    my $odds  = $param{start};
    my $reset = $param{reset} // $odds;
    my $rand  = $param{rand} // sub { CORE::rand };
    (   sub {
            if ( &$rand <= $odds ) { $odds = $reset; HIT }
            else                   { $odds += $param{step}; MISS }
        },
        sub { $odds = $param{start} }
    );
}

sub prd_bitable {
    my %param = @_;
    croak "need start table_hit table_miss values"
      unless exists $param{start}
      and exists $param{table_hit}
      and exists $param{table_miss};
    croak "table_hit must be a not-empty array ref"
      if ref $param{table_hit} ne 'ARRAY'
      or !@{ $param{table_hit} };
    croak "table_miss must be a not-empty array ref"
      if ref $param{table_miss} ne 'ARRAY'
      or !@{ $param{table_miss} };
    croak "rand must be a code ref"
      if defined $param{rand} and ref $param{rand} ne 'CODE';
    my $idxhit  = $param{index_hit}  // 0;
    my $idxmiss = $param{index_miss} // 0;
    my $table_hit  = [ @{ $param{table_hit} } ];
    my $table_miss = [ @{ $param{table_miss} } ];
    croak "index_hit outside of table bounds"
      if $idxhit < 0 or $idxhit >= @$table_hit;
    croak "index_miss outside of table bounds"
      if $idxmiss < 0 or $idxmiss >= @$table_miss;
    my $odds = $param{start};
    my $rand = $param{rand} // sub { CORE::rand };
    (   sub {
            if ( &$rand <= $odds ) {
                $idxmiss = 0;
                $odds += $table_hit->[ $idxhit++ ];
                $idxhit %= @$table_hit;
                return HIT;
            } else {
                $idxhit = 0;
                $odds += $table_miss->[ $idxmiss++ ];
                $idxmiss %= @$table_miss;
                return MISS;
            }
        },
        sub {
            $odds    = $param{start};
            $idxhit  = $param{idxhit} // 0;
            $idxmiss = $param{idxmiss} // 0;
        }
    );
}

sub prd_table {
    my %param = @_;
    croak "need start and table values"
      unless exists $param{start}
      and exists $param{table};
    croak "table must be a not-empty array ref"
      if ref $param{table} ne 'ARRAY'
      or !@{ $param{table} };
    croak "rand must be a code ref"
      if defined $param{rand} and ref $param{rand} ne 'CODE';
    my $index = $param{index} // 0;
    my $table = [ @{ $param{table} } ];
    croak "index outside of table bounds" if $index < 0 or $index >= @$table;
    my $odds  = $param{start};
    my $reset = $param{reset} // $odds;
    my $rand  = $param{rand} // sub { CORE::rand };
    (   sub {
            if ( &$rand <= $odds ) { $odds = $reset; $index = 0; HIT }
            else { $odds += $table->[ $index++ ]; $index %= @$table; MISS }
        },
        sub { $odds = $param{start}; $index = $param{index} // 0 }
    );
}

1;
__END__