Beefy Boxes and Bandwidth Generously Provided by pair Networks
Your skill will accomplish
what the force of many cannot
 
PerlMonks  

Poker Probability Processor

by Lexicon (Chaplain)
on May 11, 2001 at 12:48 UTC ( #79660=CUFP: print w/ replies, xml ) Need Help??

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.
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 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 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 # '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

Comment on Poker Probability Processor
Select or Download Code
Poker Processor in time for Poker Night!
by knobunc (Pilgrim) on May 11, 2001 at 17:16 UTC

    Wow! Cool! Just in time for poker night.

    We always have debates about what the odds are for some of the stranger games that we play. Looks like I will have to waste some time this afternoon.

    -ben

Re: Poker Probability Processor
by Mungbeans (Pilgrim) on May 15, 2001 at 14:22 UTC
    Any chance of something that would tell me what my friends were holding?

    Seriously: you may be able to verify statistics from some of the existing poker research.

    Where you classify hand, you may be able to optimise this further (this may only make a trivial increase in speed):

    1. A pair can't be a flush or a straight so don't do flush processing (in a 5 or 6 card deck, TK in a 7 card deck)
    2. Conversely (it may be faster to iterate through flush processing (4 suits vs 13 cards) first but flushes are less frequent than pairs...

    Very, very cool. Easy to read and I'm going to snaffle the parameter passing/initialisation for my next script. Thanks for posting this.

    Be careful when you go to Vegas ;-)

      The big slowdown right now is absolutly in the Flush processing. When I modulize it, I'll be checking into optimizations like you suggest. Classify_Hand takes about twice as long as Combinate. I'm sure (well, hope) I can bring it down an order of magnitude.

      The first iteration of a game enhancer version is at least 3 months away. I know what you're looking for, but making it both real-time-fast and accurate enough to be meaningful will be difficult. And then you'll have to convince them to allow your laptop at the table. ;)

      Thanks for the input! Let me know how your tweeking goes.

      -Lexicon

How to locate a good reference (was: Poker Probability Processor)
by tilly (Archbishop) on May 15, 2001 at 16:39 UTC
    I know next to nothing about poker.

    But my general belief is that anything people put energy into, someone has thought about pretty hard. And if someone has thought about it pretty hard, then someone else (likely several people in fact) has probably put that thought into a book. Given current search tools, it should be possible to locate that book if it is out there. Just look for a book on the topic with good reviews where an independent search on the author comes up with glowing reviews.

    And indeed it doesn't take long to run a few searches, sanity cross-check, and find at least one promising candidate that I got from this list. Indeed I suspect that some time spent with any book on that list would be very worthwhile.

    Of course take that with a grain of salt. I hate gambling. About all I know about poker is that the purpose of bluffing bad hands is to make it impossible for people to be sure of whether you have a good hand when you do.

    But after a short bit of research it isn't much of a gamble to say that David Sklansky is probably a good place to start for trying to learn poker.

    Now if we could only convince people trying to learn Perl to use my strategy, some of those bad titles out there might not sell so well... :-(

Re: Poker Probability Processor
by Dominus (Parson) on May 17, 2001 at 02:58 UTC
    Says lexicon:
    Straight Flush 32 0.00123 Royal Flush 4 0.00015
    Seems to me you have a problem here, since there are obviously 40 straight flushes, not 36. Did you perhaps forget A-2-3-4-5?
    Straight 9180 0.35322
    I think you made the same mistake here also. I count 10,200 straights.

    --
    Mark Dominus
    Perl Paraphernalia

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: CUFP [id://79660]
Approved by root
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others making s'mores by the fire in the courtyard of the Monastery: (20)
As of 2014-07-24 15:42 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    My favorite superfluous repetitious redundant duplicative phrase is:









    Results (161 votes), past polls