File Coverage

blib/lib/Algorithm/Gutter.pm

Criterion	Covered	Total	%
statement	74	76	97.3
branch	14	16	87.5
condition	2	3	66.6
subroutine	13	14	92.8
pod	5	5	100.0
total	108	114	94.7

# -*- Perl -*-
#
# Algorithm::Gutter - cellular automata to simulate rain in a gutter,
# or, "the hundred and forty-second worst drum machine in the West".

package Algorithm::Gutter;
use 5.26.0;
use Object::Pad 0.66;
our $VERSION = '0.02';

class Algorithm::Gutter::Cell {
    field $amount :mutator :param = 0;
    field $context :mutator;
    field $enabled :mutator :param   = 0;
    field $id :reader :param         = 0;
    field $threshold :mutator :param = ~0;
    field $update :mutator :param    = undef;

    method drain ( $index, $all = 1, $stash = undef ) {
        if ( $enabled and $amount >= $threshold ) {
            my $drained;
            if ($all) {
                $drained = $amount;
                $amount  = 0;
            } else {
                $drained = $threshold;
                $amount -= $threshold;
            }
            die "no update callback" unless defined $update;
            return $update->( $self, $index, $drained, $stash );
        }
        return;
    }
}

class Algorithm::Gutter {
    field $gutter :reader :param = [];
    field $rain :writer :param   = undef;

    # Try to drain cells, possibly triggering cell update functions.
    method drain ( $all = 1, $stash = undef ) {
        my $index = 0;
        map { $_->drain( $index++, $all, $stash ) } @$gutter;
    }

    # Adding water to the cells left as an exercise to the caller.
    method rain ( $stash = undef ) {
        die "no rain callback supplied" unless defined $rain;
        $rain->( $gutter, $stash );
    }

    # Redistribute imbalances in the water level between adjacent cells.
    # There are doubtless more complicated or more efficient ways to do
    # this, but those would take time to figure out.
    method slosh ( $max = ~0, $dmax = 1 ) {
        return if @$gutter < 2;
        my $iterations = 0;
        my $end        = @$gutter - 1;
        while ( $max-- > 0 ) {
            $iterations++;
            my $done = 1;
            for my $i ( 0 .. $end - 1 ) {
                my $delta = $gutter->[$i]->amount - $gutter->[ $i + 1 ]->amount;
                if ( $delta > $dmax ) {
                    $gutter->[$i]->amount--;
                    $gutter->[ $i + 1 ]->amount++;
                    $done = 0;
                }
            }
            for my $i ( reverse 1 .. $end ) {
                my $delta = $gutter->[$i]->amount - $gutter->[ $i - 1 ]->amount;
                if ( $delta > $dmax ) {
                    $gutter->[$i]->amount--;
                    $gutter->[ $i - 1 ]->amount++;
                    $done = 0;
                }
            }
            last if $done;
        }
        return $iterations;
    }
}

1;
__END__