Beefy Boxes and Bandwidth Generously Provided by pair Networks Joe
Clear questions and runnable code
get the best and fastest answer
 
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 taking refuge in the Monastery: (5)
As of 2014-04-17 02:28 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    April first is:







    Results (437 votes), past polls