Beefy Boxes and Bandwidth Generously Provided by pair Networks
Problems? Is your data what you think it is?
 
PerlMonks  

comment on

( [id://3333]=superdoc: 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


In reply to Poker Probability Processor by Lexicon

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":



  • Are you posting in the right place? Check out Where do I post X? to know for sure.
  • Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
    <code> <a> <b> <big> <blockquote> <br /> <dd> <dl> <dt> <em> <font> <h1> <h2> <h3> <h4> <h5> <h6> <hr /> <i> <li> <nbsp> <ol> <p> <small> <strike> <strong> <sub> <sup> <table> <td> <th> <tr> <tt> <u> <ul>
  • Snippets of code should be wrapped in <code> tags not <pre> tags. In fact, <pre> tags should generally be avoided. If they must be used, extreme care should be taken to ensure that their contents do not have long lines (<70 chars), in order to prevent horizontal scrolling (and possible janitor intervention).
  • Want more info? How to link or How to display code and escape characters are good places to start.
Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others having an uproarious good time at the Monastery: (5)
As of 2024-03-28 21:51 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found