Re: [FWP] Perl Card Games

[Matthew Bafford <*@dragons.duesouth.net> (by way of Vicki Brown)]

Date: Tue, 3 Aug 1999 17:55:42 -0400
Message-ID: <19990803175542.A4775@dragons.duesouth.net>
References: <19990803131810.E29134@fermi2.chem.yale.edu>
X-Mailer: Mutt 0.95.4us
In-Reply-To: <19990803131810.E29134@fermi2.chem.yale.edu>; from Amir 
Karger on Tue, Aug 03, 1999 at 01:18:10PM -0400
Organization: Huh?
>From vlb@cfcl.com  Tue Aug  3 15:06:31 1999

[Tue, Aug 03, 1999 at 01:18:10PM -0400] Amir Karger:
> I was playing war with my nephew this weekend. He's pretty smart for a
> seven-year-old, and he quickly realized that---rather than painstakingly
> showing each other one card at a time---we could line up all of our cards in
> a row, compare them all (with a "war" meaning we would compare the 4th card
> down the line) and then divvy up the cards for the next round.

Smart, maybe, but he does take the fun out of a game... :-)

>                                                                I nonetheless
> got pretty bored after a couple rounds and wished I could get a computer to
> do it for me.

Heh, that reminds me of the slot machine game I used to play on my ol'
C64.  After a while I got tired of pushing the 'pull' button, so I just
changed the code slightly to make the computer do it automatically.

That kinda took the last bit of fun out of it...

> So on Sunday I wrote up CardGame.pm, a module for card games, and war.pl,
> which plays war. (In fact, war.pl plays both sides, which saves the players
> lots of effort, I figure.)

:-)  And just what would Q think of that? [0]

I found your limit of 500 to be too restrictive, as I've had matches go up
to about 850 before entering a loop.  If I shuffled each players' deck
each time they went through, it would help, but I don't.

Anyho, here's my stab at it.

HtAAoF!

--Matthew

[0] I just finished rewatching The Encounter at Farpoint...
-- 
#!/usr/bin/perl -w
use strict;

my @colors = qw . H D C S . ;
my %cards  = (
                2 =>  2, 3 =>  3, 4 =>  4, 5 =>  5, 6 =>  6, 7 =>  7,
                8 =>  8, 9 =>  9, J => 10, Q => 11, K => 12, A => 13,
              );

my(@deck,   @pot,  @a,      @b     ) =  ( ) ;
my($rounds, $wars, $a_wins, $b_wins) = 0 x 4;

sub compare_cards { my ($a, $b) = map   {  /.(.)/     }     @_;
                                   $cards{$a} <=> $cards{$b}        }
sub score         { my  $c; $c += $cards{ (/.(.)/)[0] } for @_; $c }

for my $color ( @colors ) {
     for my $card ( keys %cards ) {
         push @deck, "$color$card";
     }
}

while ( @deck ) {
     push @a, splice(@deck, rand @deck, 1);
     push @b, splice(@deck, rand @deck, 1);
}

sub one_round {
     my  ($a, $b) = (shift @a,  shift @b);
     my   $comp   = compare_cards($a, $b);
     push @pot    ,              ($a, $b);
     my   $depth  = shift || 0;
 
     if ( not $comp ) {
         printf "%-6d: %2s = %2s | %sTHIS MEANS WAR\n", $rounds, $a, 
$b, ' 'x4x$depth;
 
         if ( @a < 4 ) {
             printf "      :         | %sA has too few cards, giving B 
[@a]\n", ' 'x4x($depth+1);
             push @b, @b, splice @a;
             ++$b_wins;
         } elsif ( @b < 4 ) {
             printf "      :         | %sB has too few cards, giving A 
[@b]\n", ' 'x4x($depth+1);
             push @a, @a, splice @b;
             ++$a_wins;
         } else {
             push @pot, splice(@a, 0, 3), splice(@b, 0, 3);
             ++$wars;
             one_round($depth+1);
         }
     } elsif ( $comp > 0 ) {
         printf "%-6d: %2s > %2s | %sA wins [@pot]\n", $rounds, $a, 
$b, ' 'x4x$depth;
         push @a, splice @pot;
         ++$a_wins;
     } elsif ( $comp < 0 ) {
         printf "%-6d: %2s < %2s | %sB wins [@pot]\n", $rounds, $a, 
$b, ' 'x4x$depth;
         push @b, splice @pot;
         ++$b_wins;
     }

     ++$rounds;
 
     if ( $rounds > 10000 ) {
         print "Game considered a tie after 10_000 rounds.\n";
         @a = @b = ();
         return;
     }
 
}


printf "Round : A  ~  B |\n";
one_round() while @a && @b;

print <<EOT;

Game won in $rounds rounds.
There were $wars wars.
Side A won $a_wins rounds, Side B won $b_wins rounds.
EOT

print "Side A has: ", scalar @a, " cards, with a score of ", 
score(@a), "\n" if @a;
print "Side B has: ", scalar @b, " cards, with a score of ", 
score(@b), "\n" if @b;

__END__

=pod

=head1 NAME

perlwar - Plays the card game without any interaction.

=head1 SYNOPSIS

war

=head1 DESCRIPTION

I<perlwar> plays a simple card game without any user interaction.

The rules are quite simple, and take very little time to learn.

=over 4

=item 1

First the the deck of 52 (or 54) cards is shuffled and evenly distributed
amongst the players (usually 2, but games of 3 or 4 also play quite nicely,
although slightly differently).

The joker cards are not always used.

=item 2

Each player then draws one card from the top of their deck and places it
before them, face up.

=item 3

If any cards are equal (see below), this is known as war, and the owners of
those cards lay down three more cards face down and then one face up.  For
as long as the last cards played last are equal, there is still war.

=item 4

Which ever player has the highest card played wins the all of the cards just
played, and places them at the bottom of his deck.

=item 5

Game play continues on until one player has all of the cards.

=back

=head1 CARD VALUES

Each of the cards 2-9 is equal to its face value.

The cards Jack, Queen, King, Ace, and Joker are equal to
10-14, respectivly.

=head1 BUGS

=over 4

=item *

I<perlwar> does not use Jokers.

=item *

The output is ugly.

=back

=head1 AUTHOR

This Perl version of I<perlwar> was written by
Matthew Bafford, I<*@dragons.duesouth.net>.

=head1 COPYRIGHT and LICENSE

This program is copyright (c) Matthew Bafford 1999.

This program is free and open software.  You may use, modify, distribute,
and sell this program (and any modified variants) in any way you wish,
provided you do not restrict others from doing the same.

==== Want to unsubscribe from Fun With Perl?  Well, if you insist...
==== Send email to <fwp-request@technofile.org> with message _body_
====   unsubscribe