Beefy Boxes and Bandwidth Generously Provided by pair Networks
Problems? Is your data what you think it is?
 
PerlMonks  

Perl Card Trick

by Lysander (Monk)
on Sep 15, 2002 at 02:13 UTC ( [id://197975]=sourcecode: print w/replies, xml ) Need Help??
Category: Fun Stuff
Author/Contact Info Lysander
Description: This is a card trick that I remembered doing when I was a kid. The idea behind it is pretty simple, but it may stump some of you for a moment. ;) Cheers.
As always, comments on style, syntax etc. are appreciated.

Update: The code has been modified in response to Flexx's comments below.

Update: Thanks again to Flexx for his keen eyes. As a result, I realized that I was remembering the trick wrong and have now corrected it. Both the new and semi-original script are included.


#!/usr/bin/perl -w

use strict;

my ($column, $row, @cards2);

my @cards = (
    [
         ["2", chr(4)], ["A", chr(3)], ["5", chr(3)], ["10", chr(6)]
    ],
    [
        ["Q", chr(5)], ["3", chr(3)], ["A", chr(6)], ["7", chr(5)]
    ],
    [
        ["K", chr(5)], ["6", chr(4)], ["9", chr(6)], ["J", chr(6)]
    ],
    [
        ["8", chr(3)], ["Q", chr(4)], ["3", chr(4)], ["10", chr(5)]
    ]
);

print "\n\nPick a card from below.";
&display_cards;
while (1) {
    print "Which column is your card in? ";
    $column = <STDIN>;
    chomp($column);

    if ($column =~ m/[1-4]/) { last; }
    else { print "\nPlease pick a number between 1 and 4.\n"; }
}

my %map = (4=>1, 3=>2, 2=>3, 1=>4);

for (my $i = 0; $i <= $#cards; $i++) {
    for (my $j = 0; $j <= $#cards; $j++) {
        $cards2[$i][$j] = $cards[($map{($j+1)}-1)][$i];
    }
}

@cards = @cards2;
&display_cards;

while (1) {
    print "Which column is your card in now? ";
    $row = <STDIN>;
    chomp($row);

    if ($row =~ m/[1-4]/) { last; }
    else { print "\nPlease pick a number between 1 and 4.\n"; }
}

print "\n\nYour card is: $cards[$column-1][$row-1][0]$cards[$column-1]
+[$row-1][1]\n\n";

sub display_cards {

    my ($aref1, $aref2, $i);

    print "\n\n";
    print "\t[1]\t[2]\t[3]\t[4]\n\n";
    for $aref1 (@cards) {
        print "\t";
        for $aref2 (@$aref1) {
            print "@$aref2[0]@$aref2[1]\t";
        }
        print "\n";
    }
    print "\n\n";
}

__DATA__
Below is the semi-original script.
#!/usr/bin/perl -w

use strict;

my ($column, $row, @cards2);

my @cards = (
    [
         ["2", chr(4)], ["A", chr(3)], ["5", chr(3)], ["10", chr(6)]
    ],
    [
        ["Q", chr(5)], ["3", chr(3)], ["A", chr(6)], ["7", chr(5)]
    ],
    [
        ["K", chr(5)], ["6", chr(4)], ["9", chr(6)], ["J", chr(6)]
    ],
    [
        ["8", chr(3)], ["Q", chr(4)], ["3", chr(4)], ["10", chr(5)]
    ]
);

print "\n\nPick a card from below.";
&display_cards;
while (1) {
    print "Which column is your card in (1-4, left-to-right)?  ";
    $column = <STDIN>;
    chomp($column);

    if ($column =~ m/[1-4]/) { last; }
    else { print "\nPlease pick a number between 1 and 4.\n"; }
}

for (my $i = 0; $i <= $#cards; $i++) {
    for (my $j = 0; $j <= $#cards; $j++) {
        $cards2[$i][$j] = $cards[$j][$i];
        $cards2[$j][$i] = $cards[$i][$j];
    }
}
@cards = @cards2;
&display_cards;

while (1) {
    print "Which row is your card in (1-4, bottom-to-top)? ";
    $row = <STDIN>;
    chomp($row);

    if ($row =~ m/[1-4]/) { last; }
    else { print "\nPlease pick a number between 1 and 4.\n"; }
}

print "\n\nYour card is: $cards[$column-1][$row-1][0]$cards[$column-1]
+[$row-1][1]\n\n";

sub display_cards {

    my ($aref1, $aref2, $i);
    $i = 4;

    print "\n\n";
    print "\t[1]\t[2]\t[3]\t[4]\n\n";
    for $aref1 (@cards) {
        print "[$i]\t";
        for $aref2 (@$aref1) {
            print "@$aref2[0]@$aref2[1]\t";
            
        }
        $i -= 1;
        print "\n";
    }
    print "\n\n";
}

__DATA__
Replies are listed 'Best First'.
Re: Perl Card Trick
by Flexx (Pilgrim) on Sep 15, 2002 at 02:49 UTC

    Hi, I'm too lazy to look into it right now, but (Update:finally, i wasn't) it does not work.

    Use this test input:

    Pick a card from below. (I choose 10 of s col 4 / row 1 below) [1] 2d Ah 5h 10s [2] Qc 3h As 7c [3] Kc 6d 9s Js [4] 8h Qd 3d 10c Which column is your card in (1-4, left-to-right)? 4 [1] [2] [3] [4] [1] 2d Qc Kc 8h [2] Ah 3h 6d Qd [3] 5h As 9s 3d [4] 10s 7c Js 10c Which row is your card in (1-4, top-to-bottom)? 4 Your card is: 10c

    Oops! This can't work because you'll always get rows == cols. It will only work on cards that are on 1/1, 2/2, 3/3, and 4/4, as they don't move... But it's just a small glitch...

    So long,
    Flexx

      Good catch. Thanks. I mislabeled the rows. It should go 1-4, bottom-to-top, rather than 1-4, top-to-bottom. Interesting enough, I think the trick still worked for every card except the one that you picked. :) I'm updating the code with the new labels.

        I'm sorry to tell you, but that still won't work... (try choosing 1/1 -- two of diamonds). You just shifted (mirrored) the problem...

        Now it still works for anything on 1/1 .. 4/4 in the original table...

        click Read more below for the solution...
      perhaps the code user prompts has have row and column confused.
Re: Perl Card Trick
by Flexx (Pilgrim) on Sep 15, 2002 at 06:10 UTC

    Hi again,

    BTW, nice post, Lysander, I really got hung on that one...

    Below is my quickshot version. Of course, a serious version of this would need input checks, etc., etc. I was just courious how I'd do this in a generalized way, using a flat array (like a talon of cards). This version allows for matrices of arbitrary dimensions.

    The print_matrix sub should therefore also be generic for all (quadratic) arrays -- where sqrt(@array) returns a natural number (an integer).

    #!/usr/bin/perl use strict; my $dimension = shift || 4; my @card_matrix = (1 .. $dimension ** 2); print_matrix(@card_matrix); print "\nrow? : "; my $row = <STDIN>; chomp($row); print_matrix(reverse @card_matrix); print "\ncol? : "; my $col = <STDIN>; chomp($col); print "\nsolution: ", $card_matrix[($row - 1) * $dimension + ($dimension - $col)]; sub print_matrix { my @matrix = @_; my $dimension = sqrt(@matrix); printf "\n" . "\t[%d]" x $dimension, (1..$dimension); for(my $row = 0; $row < $dimension; $row++) { printf "\n[%d]" . "\t%d" x $dimension, $row + 1, @matrix[$row * $dimension .. $row * $dimension ++ $dimension - 1]; } }

    So long,
    Flexx

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: sourcecode [id://197975]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others imbibing at the Monastery: (5)
As of 2024-03-28 23:42 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found