80 lines
2.0 KiB
Perl
80 lines
2.0 KiB
Perl
#!perl
|
|
use strict;
|
|
use warnings;
|
|
|
|
# This code was adapted from the perl6 solution for this task.
|
|
|
|
# Each element of the deck is an integer, which, when written
|
|
# in octal, has four digits, which are all either 1, 2, or 4.
|
|
|
|
my $fmt = '%4o';
|
|
my @deck = grep sprintf($fmt, $_) !~ tr/124//c, 01111 .. 04444;
|
|
|
|
# Given a feature digit (1, 2, or 4), produce the feature's name.
|
|
# Note that digits 0 and 3 are unused.
|
|
my @features = map [split ' '], split /\n/,<<'';
|
|
! red green ! purple
|
|
! one two ! three
|
|
! oval squiggle ! diamond
|
|
! solid open ! striped
|
|
|
|
81 == @deck or die "There are ".@deck." cards (should be 81)";
|
|
|
|
# By default, draw 9 cards, but if the user
|
|
# supplied a parameter, use that.
|
|
my $draw = shift(@ARGV) || 9;
|
|
my $goal = int($draw/2);
|
|
|
|
# Get the possible combinations of 3 indices into $draw elements.
|
|
my @combinations = combine(3, 0 .. $draw-1);
|
|
|
|
my @sets;
|
|
|
|
do {
|
|
# Shuffle the first $draw elements of @deck.
|
|
for my $i ( 0 .. $draw-1 ) {
|
|
my $j = $i + int rand(@deck - $i);
|
|
@deck[$i, $j] = @deck[$j, $i];
|
|
}
|
|
|
|
# Find all valid sets using the shuffled elements.
|
|
@sets = grep {
|
|
my $or = 0;
|
|
$or |= $_ for @deck[@$_];
|
|
# If all colors (or whatever) are the same, then
|
|
# a 1, 2, or 4 will result when we OR them together.
|
|
# If they're all different, then a 7 will result.
|
|
# If any other digit occurs, the set is invalid.
|
|
sprintf($fmt, $or) !~ tr/1247//c;
|
|
} @combinations;
|
|
|
|
# Continue until there are exactly $goal valid sets.
|
|
} until @sets == $goal;
|
|
|
|
print "Drew $draw cards:\n";
|
|
for my $i ( 0 .. $#sets ) {
|
|
print "Set ", $i+1, ":\n";
|
|
my @cards = @deck[ @{$sets[$i]} ];
|
|
for my $card ( @cards ) {
|
|
my @octal = split //, sprintf '%4o', $card;
|
|
my @f = map $features[$_][$octal[$_]], 0 .. 3;
|
|
printf " %-6s %-5s %-8s %s\n", @f;
|
|
}
|
|
}
|
|
|
|
exit;
|
|
|
|
# This function is adapted from the perl5i solution for the
|
|
# RosettaCode Combinations task.
|
|
sub combine {
|
|
my $n = shift;
|
|
return unless @_;
|
|
return map [$_], @_ if $n == 1;
|
|
my $head = shift;
|
|
my @result = combine( $n-1, @_ );
|
|
unshift @$_, $head for @result;
|
|
@result, combine( $n, @_ );
|
|
}
|
|
|
|
__END__
|