CUFP Lexicon This started out as (what I expected to be) a tiny program to give me some real poker stats, since I'd recently started learning to play 'real' poker with some friends and I needed to make up for their ability to count cards. Well, it exploded into two math modules, [Math::Combinatorics] and a freaky thing called [Math::Combinatorics::Combinator] which is a super generic deck shuffler. <hr width='50%'> Update4 (2001/7/13 12:18 CST): The Classify_Hand subroutine should be fixed now! The stats are updated as well, with stats I didn't generate. I need to verify my 7 card stud numbers, which will take a couple days, but I'm reasonably confident about the fix for now. If you'd like to know more than you ever wanted to know about poker, try the [http://conjelco.com/faq/poker.html|rec.games.poker faq]. Update3 (2001/5/17 9:04 GST +9): [Dominus] rules. I indeed forgot the A-2-3-4-5 combinations in the straights! I'll try to correct it this weekend and get this updated. Sorry! Update2 (2001/5/11 9:32 GST +9): If anyone sees fit to expand my program some, please let me know or post the code here. And the stats as well, of course. ;) I'd like to see how others are using it, as I havn't decided a good path for expansion yet. Update (2001/5/11 9:28 GST +9): A couple of you were wondering why I chose Brute Force computation. I could use combinatorics (combinatorics were invented for poker actually!). The reason: I plan to teach the package to play games that require 'intelligence', like 5 card draw. I believe this would defeat Combinatorics, but I'll look and see. I will do the Combinatorics to check my math and see if I can be creative enough with them to stats-out 5 card draw. That, and the Perl education was invaluable. I've now learned modules, object orientation, benchmarking, [CPAN], [Fundamental Benchmarks], [Object Oriented Performance], a whole slew of [perlfunc|new functions], etc... This is probably the largest program package I've ever written, around 1000 lines all together. <hr width='50%'> So, all the code is below for you to play with, but I'll spare everyone the suspense...here's the stats: <code> 7 CARD HAND TYPE COUNT Nothing 23,294,460 One Pair 58,627,800 Two Pair 31,433,400 Three of a Kind 6,461,620 Straight 6,180,020 Flush 4,047,644 Full House 3,473,184 Four of a Kind 224,848 Straight Flush 41,584 ------------------------------- 5 CARD HAND TYPE COUNT Nothing 1,302,540 One Pair 1,098,240 Two Pair 123,552 Three of a Kind 54,912 Straight 10,200 Flush 5,108 Full House 3,744 Four of a Kind 624 Straight Flush 36 Royal Flush 4 ------------------------------- 3 CARD HAND TYPE COUNT Nothing 16,440 One Pair 3,744 Three of a Kind 52 Flush 1,096 Straight 720 Straight Flush 48 ------------------------------- </code> <readmore> <code> #!/bin/perl -w #################################################################### # # Poker Probability Processor (PPP) # Version 1.00 11 May 2001 # Copyright 2001, Alexander Scouras # All Rights Reserved # lexicon@anapraxis.net http://code.anapraxis.net # # This program is free software. # It may be distributed and/or modified under either the # Perl Artistic License or the GNU General Public License. # #################################################################### # # This program simply calculates probabilities for games of poker. # You type in "poker.pl -h 7" and this program, in about two days, # will tell you the liklihood of each hand for a game of 7 card stud. # # Command Line Switches: # -h hhh - Size of the hand # -d ddd - Size fo the deck # -s sss - Index of hand to begin processing at # -f fff - Index of hand to finish processing at # -r rrr - Job Code to resume processing of # # PPP has a lot of nifty features that seem a little superfluous for # something which just does a lot of statistical computation. That's # because I do plan on expanding it some day to play other odd games # such as Texas Hold'Em, Chicago, HiLo, and a number of other poker # variations that most of you have probably never heard of. ;-) # # Suspend and Resume feature - Assuming you needed to calculate # a game of 8 card stud (the maximum possible before you break Perl) # it would take you around 10 days. Maybe you'd like to play Quake # and need to reclaim some of your 100% CPU usage? Simply press # 'q' and the program will stop at the next report location, which # is every $Stat_Interval (10,000 by default) hands. # # The program will issue a Job Code to you and save a text file with # the current statistics. The Job Code looks something like # '3-10000' which is simply the hand size - stopping point. To # resume, type 'poker.pl -r 3-10000' and off it goes. # # This program has a fun way to shuffle the deck: # Math::Combinatorics::Combinator. I actually started this package # for this program, then decided to make it generic. Well, most of # poker.pl took about 1 month to get to where it is. To shuffle # the deck took about 3 months by itself. It's still in Beta, but # it shuffles the deck reliably, so I'm happy to release this # little toy for everyone to play with. # # The second difficult piece is, of course, classifying each # hand. I will probably clean all this code up and release it as a # module some day. Don't hold your breath. Right now it looks # pretty reliable, and my spot checking has show it to be accurate. # Obviously I've never checked all 2.5 million hands of poker # though, and don't know of any resource that has these figures # already available (honestly havn't bothered to look) so if you # notice any errors, by all means let me know.Anyway, it's really # spiffy because it will work with any size hand that you give it, # so I didn't have to write a different classifier for each hand # size I wanted. It's also slow as hell. # #################################################################### use Term::ReadKey; use Math::Combinatorics qw(:common); use Math::Combinatorics::Combinator; use diagnostics; use warnings; use strict; #################################################################### # VARIABLES USED FOR BENCHMARKING & STATISTICS #################################################################### my $Start_Time = time; my $Last_Time = $Start_Time; my $Now; my $Since_Last; my $Seconds = 0; my $ETA = 0; my $Stat_Interval = 10000; my $Output = ""; my $LogFile = "PokerLog.txt"; my %Count = ( __=>0, OP=>0, TP=>0, TK=>0, FL=>0, ST=>0, FH=>0, SF=>0, RF=>0, FK=>0); my %Odds = ( NO=>0, OP=>0, TP=>0, TK=>0, FL=>0, ST=>0, FH=>0, SF=>0, RF=>0, FK=>0); my $Input = ""; #################################################################### # ELEMENT SETS, INCLUDING A DECK OF CARDS #################################################################### my $Class = "__"; my @Hand; my @Suits = ('C', 'D', 'H', 'S'); my @Sorted_Deck; for my $S (@Suits) { for my $V (2..14) { push @Sorted_Deck,{ S=>$S, V=>$V } } } #################################################################### # COLLECT COMMAND LINE PARAMETERS AND INITIALIZE #################################################################### my %Parameters = @ARGV; my $Hand_Size = $Parameters{"-h"} || 5; my $Deck_Size = $Parameters{"-d"} || $#Sorted_Deck + 1; my $Start_Comb = $Parameters{"-s"} || 0; my $Finish_Comb = $Parameters{"-f"} ||Choose($Deck_Size,$Hand_Size); my $Last_Comb = $Start_Comb; if ( $Parameters{"-r"} ) { Resume_Processing() } my $Combinator = Math::Combinatorics::Combinator::Initialize( $Hand_Size, \@Sorted_Deck ); #################################################################### # PRINT GENERAL INFO AND COLUMN HEADINGS #################################################################### Output("\n" . ('x' x 50) . "\n\n", $LogFile); Output( "Starting Poker Probability Processer.\n" . "Start: $Last_Comb\t\tFinish: " . ($Finish_Comb - 1) . "\n". "Current time is ". localtime() . ".\n" . ($Finish_Comb - $Start_Comb) . " combinations.\n\n" , $LogFile); Output( "Comb\tElapsed Time\tCurrent\tETA\t\tHAND\n", $LogFile); #################################################################### # GENERATE EVERY POSSIBLE COMBINATION OF THE ARRAY # PRINT STATISTICS AT INTERVALS OF $STAT_INTERVAL #################################################################### COMBINATION: for my $Comb ($Last_Comb..$Finish_Comb - 1) { #for (my $Comb = $Finish_Comb-1; $Comb >= 0; $Comb--) { @Hand = $Combinator->Combinate ( $Comb ); # Get a hand of cards $Class = Classify_Hand (\@Hand); $Count{$Class}++; # First line prints results at an interval. The second # prints results when a certain hand type is found. # This is mostly for debugging, but may be useful for # statistics, so here it is. if (($Comb % $Stat_Interval == 0) or ($Comb == $Finish_Comb-1)){ # if ($Class eq "ST") { $Now = time(); $Seconds = $Now - $Start_Time; $Since_Last = $Now - $Last_Time; $Last_Time = $Now; $ETA = ($Finish_Comb-$Comb) * $Seconds/($Comb+1); Output(sprintf("%0" . length($Finish_Comb) . "d", $Comb) ."\t" . Time_String($Seconds) . "\t" . Time_String($Since_Last) . "\t" . Time_String(int($ETA)) . "\t" . $Class . "\t" . Hand_To_String(\@Hand) . "\n" , $LogFile); $Last_Comb = $Comb; while ($Input = ReadKey(-1)) { if ($Input =~ /q/i) { last COMBINATION } } } } if ($Last_Comb != $Finish_Comb - 1) { Save_Position() } Output("\n" . ('x' x 50) . "\n\n", $LogFile); my $End_Time = time; Output ( "\nElapsed time = " . ($End_Time - $Start_Time) . " seconds.\n", $LogFile); Print_Results(); Output("\n" . ('x' x 50) . "\n\n", $LogFile); exit; #################################################################### # HAND TO STRING ( @HAND ) # CARD TO STRING ( %CARD ) #=================================================================== # Takes a card or whole hand and returns a representative string #################################################################### sub Hand_To_String { my @Hand = @{+shift}; my $STR = ""; $STR .= Card_To_String($_) . "_" for (@Hand); return $STR; } sub Card_To_String { my %Card = %{+shift}; if ($Card{V} == 11) { return "J$Card{ S }" } if ($Card{V} == 12) { return "Q$Card{ S }" } if ($Card{V} == 13) { return "K$Card{ S }" } if ($Card{V} == 14) { return "A$Card{ S }" } return "$Card{ V }$Card{ S }"; } #################################################################### # PARTIAL FACTORIAL ( $NUM, $LIMIT ) #=================================================================== # Takes the first $LIMIT iterations of the FACTORIAL ( $NUM ) #################################################################### sub PFac { my $x = shift; my $y = shift; my $z = 1; for ($x-$y+1..$x) { $z *= $_ } return $z; } #################################################################### # TIME STRING ( $SECONDS ) #=================================================================== # Takes a number of seconds and converts it into HH:MM:SS format #################################################################### sub Time_String { my $seconds = shift; my $minutes = int $seconds/60; my $hours = int $minutes/60; $seconds -= $minutes * 60; $minutes -= $hours * 60; return sprintf("%02d:%02d:%02d", $hours, $minutes, $seconds); } #################################################################### # OUTPUT ( $STRING, $LOGFILE ) #=================================================================== # Prints output to the screen and to $LOGFILE #################################################################### sub Output { my $String = shift; my $LogFile = shift; print $String; open LOG, ">>$LogFile" || die "Cannot open LOG: $!"; print LOG $String; close LOG || die "Cannot close LOG: $!"; } #################################################################### # RESUME PROCESSING ( ) #=================================================================== # Resumes processing wherever left off, Parameters are read from # logfile poker$JOBCODE.job and the file is deleted upon # upon completion or the next Save Spot. #################################################################### sub Resume_Processing { my $JobCode = $Parameters{"-r"}; my $JobFile = "poker$JobCode.job"; open JOB, "$JobFile" or die "Can't open $JobFile: $!\n"; while (<JOB>) { if (/Start\s+(\d+)/) { $Start_Comb = $1 } if (/Last\s+(\d+)/) { $Last_Comb = $1 + 1} if (/Finish\s+(\d+)/) { $Finish_Comb = $1 } if (/Handsize\s+(\d+)/) { $Hand_Size = $1 } if (/Count\s+([_\w]+)\s+(\d+)/) { $Count{$1} = $2 } } close JOB or die "Can't close $JobFile: $!\n"; } #################################################################### # SAVE POSITION #=================================================================== #################################################################### sub Save_Position { if (defined $Parameters{"-r"}) { my $OldJobCode = $Parameters{"-r"}; my $OldJobFile = "poker$OldJobCode.job"; unlink $OldJobFile; } my $JobCode = "$Hand_Size-$Last_Comb"; my $JobFile = "poker$JobCode.job"; Output("\nYour Job Code is:\t$JobCode\n", $LogFile); open JOB, ">$JobFile" or die "Can't open $JobFile: $!\n"; print JOB " Start\t$Start_Comb Last\t$Last_Comb Finish\t$Finish_Comb Handsize\t$Hand_Size "; for ( keys %Count) { print JOB "Count\t$_\t$Count{$_}\n" } close JOB or die "Can't close $JobFile: $!\n"; } #################################################################### # CLASSIFY HAND ( @HAND ) #=================================================================== # #################################################################### # TODO: COUNT A-2-3-4-5 COMBINATION IN STRAIGHTS! my (@Target_Hand, @Values, %Suits ); my ($Size, $St_Idx, $St_Len, $Fl_Suit); my ($Last_Match, $Last_Card, $SF_Match); my ($isRF, $isFK, $isST, $isFL, $isSF, $isTK, $isTP, $isOP); sub Classify_Hand { @Target_Hand = @{$_[0]}; $Size = $#Hand + 1; if ($Size > 5) { $Size = 5 } @Values = ( 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0); %Suits = ( C => 0, D => 0, H => 0, S => 0 ); $St_Last_Index = $St_Length = $Fl_Suit = 0; $isRF = $isFK = $isST = $isFL = $isSF = $isTK = $isTP = $isOP = 0; for (@Target_Hand) { $Values[ $_->{ V } ]++; $Suits { $_->{ S } }++; } if ($Values[ 14 ]) { $St_Last_Index = $St_Length = 1; } for (my $i = 2; $i <= $#Values; $i++) { my $v = $Values[$i]; if ($v >= 1) { if (++$St_Last_Index == $i) { $St_Length++ } else { $St_Length = 1; $St_Last_Index = $i } if ($St_Length > $isST) { $isST = $St_Length } } if ($v == 2) { if ($isOP) { $isTP = 1; next } else { $isOP = 1; next }} if ($v == 3) { $isTK = 1; next } if ($v == 4) { $isFK = 1; next } } if ($Suits{ C } >= $Size) { $isFL = 1; $Fl_Suit = "C" } if ($Suits{ D } >= $Size) { $isFL = 1; $Fl_Suit = "D" } if ($Suits{ H } >= $Size) { $isFL = 1; $Fl_Suit = "H" } if ($Suits{ S } >= $Size) { $isFL = 1; $Fl_Suit = "S" } if ($isST < $Size) { $isST = 0 } if ($isST && $isFL) { $Last_Card = 0; $Last_Match = 0; for (@Target_Hand) { if ($_->{ V } == 14 && $_->{ S } eq $Fl_Suit) { $Last_Card = 1 } } STRAIGHTFLUSH: for (@Target_Hand) { if ($_->{ S } eq $Fl_Suit) { if ($_->{ V } == ++$Last_Card) { $Last_Match = $Last_Card; if (++$SF_Match >= $Size) { last STRAIGHTFLUSH } } else { $Last_Match = $Last_Card = $_->{ V }; $SF_Match = 1; } } else { $SF_Match = $Last_Match = $Last_Card = 0; } } if ($SF_Match >= $Size) { if ($Last_Match == 14) { $isRF = 1 } else { $isSF = 1 } } } if ($isRF) { return "RF" } if ($isFK) { return "FK" } if ($isSF) { return "SF" } if ($isTK && $isOP) { return "FH" } if ($isST) { return "ST" } if ($isFL) { return "FL" } if ($isTK) { return "TK" } if ($isTP) { return "TP" } if ($isOP) { return "OP" } return "__"; } sub Print_Results { my $Sampled = $Last_Comb - $Start_Comb; if (!$Sampled) { Output ("No data as of yet", $LogFile) } Output( "HAND TYPE COUNT\t% of TOTAL\n", $LogFile); Output( "Nothing " . sprintf( "%10d" , $Count { __ }) . "\t" . sprintf( "%10.5f", $Count { __ } / $Sampled * 100) . "\n", $LogFile); Output( "One Pair " . sprintf( "%10d" , $Count { OP }) . "\t" . sprintf( "%10.5f", $Count { OP } / $Sampled * 100) . "\n", $LogFile); Output( "Two Pair " . sprintf( "%10d" , $Count { TP }) . "\t" . sprintf( "%10.5f", $Count { TP } / $Sampled * 100) . "\n", $LogFile); Output( "Three - Kind " . sprintf( "%10d" , $Count { TK }) . "\t" . sprintf( "%10.5f", $Count { TK } / $Sampled * 100) . "\n", $LogFile); Output( "Flush " . sprintf( "%10d" , $Count { FL }) . "\t" . sprintf( "%10.5f", $Count { FL } / $Sampled * 100) . "\n", $LogFile); Output( "Straight " . sprintf( "%10d" , $Count { ST }) . "\t" . sprintf( "%10.5f", $Count { ST } / $Sampled * 100) . "\n", $LogFile); Output( "Full House " . sprintf( "%10d" , $Count { FH }) . "\t" . sprintf( "%10.5f", $Count { FH } / $Sampled * 100) . "\n", $LogFile); Output( "Four - Kind " . sprintf( "%10d" , $Count { FK }) . "\t" . sprintf( "%10.5f", $Count { FK } / $Sampled * 100) . "\n", $LogFile); Output( "Straight Flush" . sprintf( "%10d" , $Count { SF }) . "\t" . sprintf( "%10.5f", $Count { SF } / $Sampled * 100) . "\n", $LogFile); Output( "Royal Flush " . sprintf( "%10d" , $Count { RF }) . "\t" . sprintf( "%10.5f", $Count { RF } / $Sampled * 100) . "\n", $LogFile); } </code> -[Lexicon]