Zhris
Enthusiast
Sep 27, 2013, 1:18 PM
Views: 355242

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:
 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
#!/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=s4nA_jMcOo ). Chris
(This post was edited by Zhris on Sep 27, 2013, 2:05 PM)
