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 rec.games.poker faq.
Update3 (2001/5/17 9:04 GST +9): Dominus rules. I indeed forgot the A2345 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 statsout 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 new functions, etc... This is probably the largest program package I've ever written, around 1000 lines all together.
So, all the code is below for you to play with, but I'll spare everyone the suspense...here's the stats:
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 
#!/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 # '310000' which is simply the hand size  stopping point. To # resume, type 'poker.pl r 310000' 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_Comb1; $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_Comb1)){ # 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 A2345 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); }


Replies are listed 'Best First'.  

Re: Poker Probability Processor
by Dominus (Parson) on May 17, 2001 at 02:58 UTC  
How to locate a good reference (was: Poker Probability Processor)
by tilly (Archbishop) on May 15, 2001 at 16:39 UTC  
Re: Poker Probability Processor
by Mungbeans (Pilgrim) on May 15, 2001 at 14:22 UTC  
by Lexicon (Chaplain) on May 15, 2001 at 15:28 UTC  
Poker Processor in time for Poker Night!
by knobunc (Pilgrim) on May 11, 2001 at 17:16 UTC 