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,
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
So, all the code is below for you to play with, but I'll spare everyone the suspense...here's the stats:
#!/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);
}
-Lexicon