Anonymous user
Set puzzle: Difference between revisions
Added Perl translation of Perl6 implementation.
(Added Perl translation of Perl6 implementation.) |
|||
Line 681:
purple two diamond striped</pre>
=={{header|Perl}}==
{{trans|Perl6}}
It's actually slightly simplified, since generating Enum classes
and objects would be overkill for this particular task.
<lang 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__
</lang>
{{out}}
<pre>Drew 12 cards:
Set 1:
red three oval striped
green three diamond striped
purple three squiggle striped
Set 2:
red three oval striped
purple three squiggle open
green three diamond solid
Set 3:
purple one diamond striped
red three diamond striped
green two diamond striped
Set 4:
green three diamond striped
green three diamond open
green three diamond solid
Set 5:
red three diamond striped
green three oval solid
purple three squiggle open
Set 6:
green two diamond striped
purple three squiggle striped
red one oval striped</pre>
=={{header|Python}}==
<lang python>#!/usr/bin/python
| |||