CGI/Perl Guide | Learning Center | Forums | Advertise | Login
Site Search: in

  Main Index MAIN
INDEX
Search Posts SEARCH
POSTS
Who's Online WHO'S
ONLINE
Log in LOG
IN

Home: Fun With Perl: Perl Quizzes - Learn Perl the Fun Way: Re: [BillKSmith] Cool Perl: Edit Log



Zhris
Enthusiast

Sep 27, 2013, 1:18 PM


Views: 192403
Re: [BillKSmith] Cool Perl

It would be very cool if there was a pattern to the geometric equations making it easy to draw different shapes. Though I could have typed that heart a lot quicker than I could have programmed it. Inevitably, i'll stick to graphics modules for my drawing needs.

Heres another piece of code I wrote a while back, in its rough state. Its ultimately a blackjack / pontoon algorithm, which takes a list of cards and returns a string identifying the best hand. The main difficulty was that ace can be 1 or 11.

Possible hands:

Code
- The best hand of all is a Pontoon, which is 21 points in two cards - this can only consist of ace plus a picture card or ten. 
- Next best after a Pontoon is a Five Card Trick, which is a hand of five cards totaling 21 or less.
- A hand of three or four cards worth 21 points beats everything else except a Pontoon or Five Card Trick.
- Hands with 20 or fewer points and fewer than five cards rank in order of their point value - the nearer to 21 the better.
- Hands with more than 21 points are bust and are worthless.


main.pl

Code
#!/usr/bin/perl 
use strict;
use warnings FATAL => qw/all/;
use Data::Dumper;

our $deck =
{
'2H' => [2] ,
'3H' => [3] ,
'4H' => [4] ,
'5H' => [5] ,
'6H' => [6] ,
'7H' => [7] ,
'8H' => [8] ,
'9H' => [9] ,
'10H' => [10] ,
'JH' => [10] ,
'QH' => [10] ,
'KH' => [10] ,
'AH' => [1,11] ,
'2D' => [2] ,
'3D' => [3] ,
'4D' => [4] ,
'5D' => [5] ,
'6D' => [6] ,
'7D' => [7] ,
'8D' => [8] ,
'9D' => [9] ,
'10D' => [10] ,
'JD' => [10] ,
'QD' => [10] ,
'KD' => [10] ,
'AD' => [1,11] ,
'2S' => [2] ,
'3S' => [3] ,
'4S' => [4] ,
'5S' => [5] ,
'6S' => [6] ,
'7S' => [7] ,
'8S' => [8] ,
'9S' => [9] ,
'10S' => [10] ,
'JS' => [10] ,
'QS' => [10] ,
'KS' => [10] ,
'AS' => [1,11] ,
'2C' => [2] ,
'3C' => [3] ,
'4C' => [4] ,
'5C' => [5] ,
'6C' => [6] ,
'7C' => [7] ,
'8C' => [8] ,
'9C' => [9] ,
'10C' => [10] ,
'JC' => [10] ,
'QC' => [10] ,
'KC' => [10] ,
'AC' => [1,11] ,
};

my $total;
print Dumper pontoon(['AH', 'KC'], \$total), $total;

sub pontoon
{
my ($hand, $total) = @_;

return 'nohand' if (!@$hand);
#return 'ok' if (@$hand == 1); # can only be ok if 1 card in hand. No total here yet though.

($$total) = sort { $b <=> $a } # order highest total first
grep { $_ <= 21 } # filter totals less than 22
map { list_total($_) } @{sequences($hand)}; # convert list to total of elements

return 'bust' if (!$$total);
return 'fivecard' if (@$hand > 4);
return 'pontoon' if (@$hand == 2 && $$total == 21);
return 'twentyone' if ($$total == 21);
return 'ok';
}

# sequences could be more efficient when no sequences yet and/or only 1 value.
sub sequences
{
my ($hand) = @_;

return () unless @$hand;

my @sequences = ([]);

foreach my $card (@$hand)
{
my $values = $deck->{$card};

my @sequences_new;

foreach my $value (@$values)
{
my @sequences_copy = map { [@$_] } @sequences; # deep copy sequences

push @$_, $value foreach (@sequences_copy);

push @sequences_new, @sequences_copy;
}

@sequences = @sequences_new;
}

return \@sequences;
}

sub list_total
{
my ($list) = @_;

my $total;
$total += $_ foreach (@$list);

return $total;
}


I plan on eventually using the algorithm to replicate the fun single player game Target 21 ( http://www.youtube.com/watch?v=s4n-A_jMcOo ).

Chris


(This post was edited by Zhris on Sep 27, 2013, 2:05 PM)


Edit Log:
Post edited by Zhris (Enthusiast) on Sep 27, 2013, 1:19 PM
Post edited by Zhris (Enthusiast) on Sep 27, 2013, 1:23 PM
Post edited by Zhris (Enthusiast) on Sep 27, 2013, 1:32 PM
Post edited by Zhris (Enthusiast) on Sep 27, 2013, 1:47 PM
Post edited by Zhris (Enthusiast) on Sep 27, 2013, 2:05 PM


Search for (options) Powered by Gossamer Forum v.1.2.0

Web Applications & Managed Hosting Powered by Gossamer Threads
Visit our Mailing List Archives