|
skrapasor has asked for the wisdom of the Perl Monks concerning the following question:
wikipedia article on Set for convenience.
It's a simple game, and I wrote a small script to find matches in a group of cards. My script finds all the combinations of 2 cards, finds the potential match for each combination, and looks to see if that match is in the group of cards. The problem is that each match will be found three times because it finds 2 cards which can match one card, and then it finds 2 other cards, which could both be part of the previous match, and would make the same match. Basically, my script thinks order matters but it doesnt, and making order unimportant requires *extra* work. Here is my script:
#!/usr/bin/perl
use warnings;
sub third {
#this returns the the same number if the inputs
#are the same, or if they are different it returns the
#number that was not input (of the set {1,2,3})
my @numbers = @_;
if ( $numbers[0] == $numbers[1] ) {
return $numbers[0];
}
else {
if ( ($numbers[0] + $numbers[1]) == 3 ) {
return 3;
}
elsif ( ( $numbers[0] + $numbers[1]) == 4 ) {
return 2;
}
else {
return 1;
}
}
}
sub find_match {
#this returns the match of two cards in an array of the form
#(a,b,c,d) of which a,b,c,d are each a number 1-3 to
#represent shape, color, pattern, and number of shapes
#on a card
my @cards = @_;
my @return;
$return[0] = third($cards[0]->[0],$cards[1]->[0]);
$return[1] = third($cards[0]->[1],$cards[1]->[1]);
$return[2] = third($cards[0]->[2],$cards[1]->[2]);
$return[3] = third($cards[0]->[3],$cards[1]->[3]);
return @return;
}
sub combo {
#this i stole from a perlmonks question to
#find every combination of 2 cards in a group
my $by = shift;
return sub { () } if ! $by || $by =~ /\D/ || @_ < $by;
my @list = @_;
my @position = (0 .. $by - 2, $by - 2);
my @stop = @list - $by .. $#list;
my $end_pos = $#position;
my $done = undef;
return sub {
return () if $done;
my $cur = $end_pos;
{
if ( ++$position[ $cur ] > $stop[ $cur ] ) {
$position[ --$cur ]++;
redo if $position[ $cur ] > $stop[ $cur ];
my $new_pos = $position[ $cur ];
@position[ $cur .. $end_pos ] = $new_pos .. $new_pos +
+ $by;
}
}
$done = 1 if $position[0] == $stop[0];
return @list[ @position ];
}
}
#example cards
@card1=(2,2,1,1);
@card2=(2,2,3,3);
@card3=(2,2,2,2);
@card4=(2,2,3,2);
#example group of cards
@cards=(\@card1, \@card2, \@card3, \@card4);
#$iter finds a subset of length 2 of @cards
my $iter = combo( 2, @cards);
#this loop loops through every combo of two cards
#and looks for a potential match
#then checks to see if the match exists in the group of
#@cards
#the problem occurs because each match is found thrice
while ( my @combo = $iter->() ) {
my @match = find_match(@combo);
my $first = $combo[0];
my $second = $combo[1];
my @altered_cards = @cards;
foreach $card (@cards) {
if(join("",@match)==join("",@$card)){
print "Match =", @match, "\n";
print "Card =", @$card, "\n";
print "Match!\n";
@$first, "\n", @$second, "\n", @match, "\n";
last;
}
}
}
Any other coding suggestions would also be helpful.
To be clear, I can't figure out how I would check to see if a match was already found. But have another question about dereferencing the arrays of references. When I tried @$combo[0] it didn't work, but when I put $combo[0] into $first, and then used @$first, it worked, which seemed to me like the same thing, so I don't understand that either.
Edit: BTW, some of the things I did served no purpose (my @altered_cards = @cards) |
Re: Solver for the game "Set" matches three times (octal)
by tye (Sage) on Jul 15, 2008 at 14:29 UTC
|
Here is a cute trick that you might want to contemplate.
If you make each card a 4-"digit" octal number, then three cards form a "set" if and only if ($a|$b|$c) equals ($a^$b^$c). You can use octal strings or octal numbers. I use octal strings below:
#!/usr/bin/perl -w
use strict;
my %Desc= qw(
0001 One
0002 Two
0004 Three
0010 Red
0020 Blue
0040 Green
0100 Hollow
0200 Striped
0400 Solid
1000 Diamond
2000 Squiggle
4000 Oval
);
my @deck;
for my $a ( 1,2,4 ) {
for my $b ( 1,2,4 ) {
for my $c ( 1,2,4 ) {
for my $d ( 1,2,4 ) {
push @deck, "$a$b$c$d";
}
}
}
}
sub isSet {
my( $a, $b, $c )= @_;
return ($a|$b|$c) eq ($a^$b^$c);
}
sub showCard {
my( $card )= @_;
my @desc;
for my $bit ( sort keys %Desc ) {
if( $bit eq ( $bit & $card ) ) {
push @desc, $Desc{$bit};
}
}
return "@desc";
}
while( 1 ) {
for my $n ( reverse @deck-2..@deck ) {
my $r = rand $n;
@deck[$n-1,$r]= @deck[$r,$n-1];
}
if( isSet( @deck[-3..-1] ) ) {
print showCard( $_ ), $/
for @deck[-3..-1];
exit;
}
}
Update: Replaced nested maps with clearer, shorter for()s.
| [reply]
[d/l]
[select] |
|
|
This might sound stupid, but what does return ($a|$b|$c) eq ($a^$b^$c); do?
| [reply]
[d/l] |
|
|
For each bit, ($a^$b^$c) returns
- 1 if all three cards share the value represented by that bit (e.g. all three cards are green),
- 0 if exactly two of three cards share the value represented by that bit (e.g. two of the three cards are green, and the one others isn't),
- 1 if exactly one of three cards share the value represented by that bit (e.g. one of the three cards is green, and the two others aren't),
- 0 if none of the three cards share the value represented by that bit (e.g. none of the cards are green).
We want
- 1 if all three cards share the value represented by that bit (e.g. all three cards are green),
- 0 if exactly two of three cards share the value represented by that bit (e.g. two of the three cards are green, and the one others isn't),
- 1 if exactly one of three cards share the value represented by that bit (e.g. one of the three cards is green, and the two others aren't),
- 1 if none of the three cards share the value represented by that bit (e.g. none of the cards are green).
($a|$b|$c) eq serves that purpose and to "and" the results of every bit into a single boolean value.
| [reply]
[d/l]
[select] |
Re: Solver for the game "Set" matches three times
by ChOas (Curate) on Jul 15, 2008 at 06:09 UTC
|
I personally would try to keep track of the unique combinations of the cards using a hash, the keys being the card
sorted contactenated shape/color/pattern values of the cards.
so if I have 2 cards 2,3,1,2 and 1,2,3,1
first create two keys,
2312 and 1231, sort them
1231,2312, concat them as a key ++$unique_combo{"12312312"};
After been over all the cards the keys in my hash will be the unique combinations.
Further, @{$combo->[0]} should just dereference your array
GreetZ!,
print "profeth still\n" if /bird|devil/;
| [reply] |
Re: Solver for the game "Set" matches three times
by GrandFather (Saint) on Jul 15, 2008 at 06:43 UTC
|
| [reply] |
Re: Solver for the game "Set" matches three times
by pc88mxer (Vicar) on Jul 15, 2008 at 16:04 UTC
|
You can use PDL to simplify these calculations. As you have it, a card is just an array of four numbers mod 3. You are using 1, 2 and 3 but you can also use 0, 1 and 2.
Then a set is just three cards X, Y, Z where X+Y+Z = (0,0,0,0) mod 3.
use PDL;
sub is_a_set {
all (($_[0] + $_[1] + $_[2]) % 3) == 0;
}
sub third_card {
(pdl(3,3,3,3)-$_[0]-$_[1]) % 3;
}
my $X = pdl(0,1,2,2);
my $Y = pdl(0,2,2,1);
my $Z = pdl(0,0,2,0);
if (is_a_set($X, $Y, $Z)) {
print "$X, $Y and $Z form a set\n";
} else {
print "$X, $Y and $Z do not form a set\n";
}
print "To form a set with $X and $Y you need: ", third_card($X, $Y), "
+\n";
| [reply]
[d/l]
[select] |
Re: Solver for the game "Set" matches three times
by jethro (Monsignor) on Jul 15, 2008 at 13:14 UTC
|
Here is an easy filter: Print only those sets where the three cards are in ascending order. This presumes that the cards have some sort of order/number associated with them. So you would print cards 0 5 and 12, but not cards 5, 12 and 0 or cards 12, 5 and 0.
If you don't have the card number available at that time you can construct one: If the card is (a,b,c,d), the number is a+b*3+c*9+d*27.
Obviously you can do this filtering not only as late as when you print but also when you generate the combos and when you search for the third card (i.e. start with the search one card after the second of the two combo cards and expect to find no third card in some cases).
| [reply] |
|
|
