view release on metacpan or  search on metacpan

lib/Acme/Siteswap.pm  view on Meta::CPAN

package Acme::Siteswap;
use strict;
use warnings;

use List::Util qw( max reduce );

=head1 NAME

Acme::Siteswap - Provide information about Juggling Siteswap patterns

=head1 SYNOPSIS

  use Acme::Siteswap;
  my $siteswap = Acme::Siteswap->new(
      pattern => '53142',
      balls => 3,
  );
  print "Awesome!\n" unless $siteswap->valid;

=cut

our $VERSION = '0.03';

=head1 FUNCTIONS

=head2 new

Create a new Acme::Siteswap object.

Options:

=over 4

=item pattern

Mandatory.  The siteswap pattern.  Should be a series of throws.

=item balls

Mandatory.  The number of balls in the pattern.

=back

=cut

sub new {
    my $class = shift;
    my $self = { @_ };
    die "A siteswap pattern is required!" unless defined $self->{pattern};
    die "The number of balls is required!" unless defined $self->{balls};
    bless $self, $class;
    return $self;
}

=head2 valid

Determines if the specified pattern is valid.

=cut

sub valid {
    my $self = shift;
    my $pattern = $self->{pattern};

    my @throws;
    eval { @throws = _pattern_to_throws($pattern) };
    if ($@) {
        $self->{error} = $@;
        return 0;
    }

    # Check that the numbers / throws == # of balls
    my $total = 0;
    for my $t (@throws) {
        if (ref $t eq 'ARRAY') {
            foreach my $m_t (@$t) {
                $total += $m_t;
            }
        }
        else {
            $total += $t;
        }
    }

    my $avg = $total / @throws;
    unless ($avg == $self->{balls}) {
        $self->{error} = "sum of throws / # of throws does not equal # of balls!";
        return 0;
    }
	
    return $self->_check_timing(@throws);
}

sub _check_timing {
    my ($self, @throws) = @_;
    
    # foreach non-zero throw, mark where the ball will next be
    # thrown and make sure that each throw is fed.
    my @throw_map = map { ref $_ eq 'ARRAY' ? scalar(@$_) 
                                            : ( $_ > 0 ? 1 : 0 ) } @throws;
    my @feeds = (0) x scalar @throws;
    for my $i (0 .. $#throws) {
        my @subthrows = ref $throws[$i] eq 'ARRAY' ? @{$throws[$i]} 
                                                   : ($throws[$i]);
        
        foreach my $throw (@subthrows) {
            next if $throws[$i] == 0;
            my $next_thrown = ($i + $throw) % scalar @throws;
            $feeds[$next_thrown]++;
        }
    }