File Coverage

blib/lib/Games/Set.pm

Criterion	Covered	Total	%
statement	47	53	88.6
branch	6	6	100.0
condition			n/a
subroutine	12	13	92.3
pod	5	5	100.0
total	70	77	90.9

use strict;
package Games::Set;
use Games::Set::Card;
use Algorithm::ChooseSubsets;
use Algorithm::GenerateSequence;
use List::Util qw( max );
use Class::Accessor::Fast;
use base 'Class::Accessor::Fast';
__PACKAGE__->mk_accessors(qw( deck ));

use vars qw( $VERSION );
$VERSION = '0.01';

=head1 NAME

Games::Set - The rules for the game of Set

=head1 SYNOPSIS

  my $game = Games::Set->new({ deck => [ Games::Set->standard_deck ] });
  $game->shuffle;
  my @cards = map { $game->deal } 1..3; # give me 3 cards
  print $game->set( @cards ) ? "set\n" : "no set\n";

=head1 DESCRIPTION

Games::Set understands some of the rules of the card game Set.  It
also knows how to generate a standard deck.

=head1 METHODS

=head2 new

Class::Accessor inherited constructor, returns a new gamestate

=head2 deck

The current deck.  A reference to an array containing many
Games::Set::Card objects.

=head2 shuffle

Shuffle the current deck.

=cut

# the fisher-yates shuffle from perlfaq4

sub shuffle {
    my $self = shift;
    my $deck = $self->deck;

    my $i = @$deck;
    while ($i--) {
        my $j = int rand ($i+1);
        @$deck[$i,$j] = @$deck[$j,$i];
    }
}

=head2 deal

Take a card from the top of the deck.

=cut

sub deal {
    my $self = shift;
    shift @{ $self->deck };
}

=head2 standard_deck

Calculates the standard deck as a list of Games::Set::Card objects.

=cut

sub standard_deck {
    my $self = shift;
    my $iter = Algorithm::GenerateSequence->new(
        values %Games::Set::Card::properties
       );
    map {
        my %h; @h{ keys %Games::Set::Card::properties } = @$_;
        Games::Set::Card->new(\%h)
      } $iter->as_list;
}


=head2 set( @cards )

Returns true if the cards make a set.

=cut

sub set {
    my $self = shift;
    for my $property ( keys %Games::Set::Card::properties ) {
        my %seen;
        $seen{ $_->$property() }++ for @_;
        next if (keys %seen)       == 1; # all same
        next if (max values %seen) == 1; # all different
        return;
    }
    return 1;
}

=head2 find_sets( @cards )

returns all the possible sets within @cards as array references

=cut

sub find_sets {
    my $self = shift;

    my @found;
    my $iter = Algorithm::ChooseSubsets->new( \@_, 3 );
    while (my $set = $iter->next) {
        push @found, $set if $self->set(@$set);
    }
    return @found;
}


1;
__END__