Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl: the Markov chain saw
 
PerlMonks  

Perl Card Trick

by Lysander (Monk)
on Sep 15, 2002 at 02:13 UTC ( #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__

Comment on Perl Card Trick
Select or Download Code
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

      perhaps the code user prompts has have row and column confused.
      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...
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

Back to Code Catacombs

Log In?
Username:
Password:

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

How do I use this? | Other CB clients
Other Users?
Others contemplating the Monastery: (4)
As of 2014-09-22 23:04 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    How do you remember the number of days in each month?











    Results (208 votes), past polls