File Coverage

blib/lib/Random/Skew.pm

Criterion	Covered	Total	%
statement	85	87	97.7
branch	41	46	89.1
condition	4	7	57.1
subroutine	8	8	100.0
pod	5	5	100.0
total	143	153	93.4

package Random::Skew;

#use 5.028001;
use strict;
use warnings;

our $VERSION = '0.09';

our $GRAIN = 72; # default
sub GRAIN {
    if ( @_ ) {
        my $grain = shift( @_ );
        if ( $grain =~ /\D/ ) {
            die "\$Random::Skew::GRAIN must be a positive integer >= 2";
        } elsif ( $grain >= 2 ) {
            $GRAIN = int( $grain );
        } else {
            die "\$Random::Skew::GRAIN must be >= 2";
        }
    }
    return $GRAIN;
}

our $ROUNDING = 0.5; # default
sub ROUNDING {
    if ( @_ ) {
        my $rounding = shift( @_ );
        if ( $rounding =~ /[^0-9.]/ ) {
            die "\$Random::Skew::ROUNDING must be decimal-point and digits only (floating point)";
        } elsif ( $rounding < 0.0 or $rounding > 1.0 ) {
            die "\$Random::Skew::ROUNDING must be between 0.0 and 1.0";
        } else {
            $ROUNDING = $rounding;
        }
    }
    return $ROUNDING;
}



sub new {
    my $class = shift;
    my %params = @_ or die "Random::Skew->new: No parameters?";

    my $tot = 0;
    my @bad;
    push @bad, "Random::Skew::GRAIN ($GRAIN) must be larger than 2" unless $GRAIN > 2;
    for ( keys %params ) {
        no warnings qw/numeric/;
        my $v = $params{ $_ } + 0.0;
        if ( $v >= 1 ) {
            $tot += $v;
        } else {
            push @bad,"Value '$params{$_}' for key '$_' must be a number >= 1";
        }
    }
    die @bad if @bad;

    my $self = bless {
        _set => [],
        _tot => $tot,
        _grain => $GRAIN,
        _params => { %params },
        _unique => scalar( keys %params ),
        _fraction => 0, # for when we have fine-grained details
    }, $class;

    my $small_skew;
    # Do we need to $scale our population down to fit $Random::Skew::GRAIN buckets?
    if ( $tot > $GRAIN ) {

        # Biggest to smallest
        my @ordered = sort { $params{ $b } <=> $params{ $a } or $a cmp $b } keys %params;

        # so that we fit in 1..GRAIN buckets
        my $scale = $GRAIN / $tot;
        my %big;
        my %small;
        my $running_tot = $tot * $scale;
#$DB::single = 1;
        foreach my $item ( @ordered ) {

            my $vec = $scale * $params{ $item };

            if ( $running_tot < 1.0 ) {

                # Remaining items are, all together, smaller than one bucket...
                # Small items get their own Random::Skew
                $small{ $item } = $params{ $item }; # original weighting
                if ( not $self->{ _fraction } ) {
                    $self->{ _fraction } = $running_tot;
                }

            } elsif ( $vec < 1.0 ) {

                # We are looking at contents smaller than one bucket at this scale...
                # (e.g. 30 items with a weight of 10 each, with GRAIN=20 f'rinstance)
                if ( %big ) {
                    $small{ $item } = $params{ $item }; # original weighting
                    if ( not $self->{ _fraction } ) {
                        $self->{ _fraction } = $running_tot;
                    }
                } else {
                    my $try = int( $GRAIN / $vec + 0.999999 );
                    # GRAIN=12
                    # POP=15 10s [10 10 10 10 10 10 10 10 10 10 10 10 10 10 10]
                    # grain needs to be 15, or 150(tot) / 10(biggest score)
                    # $tot / $params{ $item }
                    die "\$Random::Skew::GRAIN ($GRAIN) too small for this population (try >$try)";
                }

            } else {

                # Big items are $scale'd to 0..$GRAIN (+.5 for rounding)
                $big{ $item } = $vec + $ROUNDING; # scaled weighting

            }

            $running_tot -= $vec;

        }

        %params = %big;
        $small_skew = Random::Skew->new( %small ) if %small;

    }

    # Load up our set with items, one of which gets returned each ->item() call at random
    foreach my $item ( keys %params ) {
        my $bucket = int( $params{ $item } );
        push @{ $self->{_set} }, ( $item ) x $bucket;
    }

    if ( $small_skew ) {

        # In case the big items are numerous and similar, they may
        # not be very large related to the $tot, so pad extra items
        # to get us up to $GRAIN buckets
        my $fraction = int( $self->{_fraction} ) - 1; # leave room for $small_skew
        $fraction = 0 if $fraction < 0;
        my @blanks = ('') x $fraction;

        # Item [0] will be the zoom-in small set, for recursion
        unshift @{ $self->{_set} }, $small_skew, @blanks;

    }

    $self->{_pop} = scalar @{ $self->{_set} };

    return $self;

}



sub item {
    my $self = shift;

    my $fraction = $self->{_fraction} // 0;
    my $set = $self->{_set};
    my $pop = scalar @$set;

    RANDOMIZE: {

        # Pick a floating point random number from 0.0 up to $pop
        my $ix = rand( $pop );

        # Shortcut for when there's no smaller scale to recurse thru:
        return $set->[ $ix ] unless $fraction;

        if ( $ix <= $fraction ) {
            # Calls the smaller-set Random::Skew object
            return $set->[0]->item(); # RECURSION: zoom in, get an item from the smaller subset

        } elsif ( $ix >= 1.0 ) {
            return $set->[ $ix ];

        } else {
            # rand(0.0 .. _pop) is in the gap, > _fraction and < 1.0
            redo RANDOMIZE;
        }

    }

}



sub items {
    my $self = shift;
    my $ct   = shift || 1;

    my @v;
    push @v, $self->item # standard Random::Skew->item call
        while $ct -- > 0;

    return @v;
}



return $VERSION;

__END__