Having finally left University and not having statred work yet, I got bored. Given that a friend recently got me into Texas Hold'ems Poker, I thought that I'd write a tool which calculates the odds of winning a round with a given hand (assuming that everyone plays to the end.)
The tool itself does this through brute force, and hence is terribly inelegant. It is also fairly inefficient, but it works.
As always, any help, suggestions or constructive criticisms are always welcome. This includes pointing out really boneheaded things, which I am occasionally known to do.
Note that as with all of my submissions, I've had to retype it so mistakes will be there which I haven't spotted.
#! /usr/bin/perl -w
use strict;
# Gaz Morris' / Elgon's Texas Hold'ems
# Statistical Analysis Tool June 2002
# NB - Gaz Morris == Elgon
# The author allows the copying, distribution,
# modification, hacking and
# otherwise fiddling with the code herewritten provided
# that attribution
# is made to him. However he can accept absolutely no
# responsibility for
# your incompetence, stupidity or any repercussions
# whatsoever from using
# this code including, but not limited to, fire, theft
# nuclear war, legal
# action or failure to work in any way whatsoever. There.
# This program calculates the odds of a given card pair
# winning a hand
# in Texas Hold'ems Poker through brute force calculation.
#Codes...
# a=2, b=3, c=4...l=king, m=ace
# 1-4 represent the various suits
# (This is only for the purpose of detecting flushes, as
# suits do not affect order
# hence it doesn't matter to which suit each number
# corresponds.)
# $iterations stores the number of hands to be played in
# the cycle
# NB - The more iterations, the more accurate the result,
# however the more time taken
# but then again if you really wanted speed, you should
# have found one written in C!
my $iterations = 100;
my $cycle;
my $win;
my $wins;
for($cycle = 0; $cycle < $iterations; ++$cycle)
{
# Okay, let's set things up, starting with the player's
# hand.
# Two cards are required. Ace/King suited in this example.
my @hand = ('n2', 'm2');
# Now we want to produce an array which contains all our
# cards, namely
# a1 -> m4 and which we shall name @deck...
my @deck;
my $card;
my @cards = ('a','b','c','d','e','f','g','h','i','j','k','l','m');
my $index;
my $nextcard;
foreach $card(@cards)
{
for ($index = 1; $index <= 4; ++$index)
{
$nextcard = $card.$index;
push (@deck, $nextcard);
}
}
# Now we need to shuffle the cards and then assign them
# to another array...
my @shuffled_deck;
my $random;
unshift (@deck, 'xx');
for ($index = 52; $index >= -1; --$index;)
{
$random = int(rand $index) + 1;
push (@shuffled_deck, $deck[random]) or die "Index Cockup!";
splice (@deck, $random, 1);
}
# Now cut out the pair of cards assigned to the test
# hand...
for ($index = 0; $index <= 51; ++$index;)
{
if ( $shuffled_deck[$index] eq $hand[0]
or $shiffled_deck[$index] eq $hand[1])
{
splice (@shuffled_deck, $index, 1);
}
}
# Now we have a test par and a shuffled and cleaned deck,
# we can deal out cards for the
# other nine players - 10 is the most common number of
# players in a casino game.
my @p2_hand;
my @p3_hand;
my @p4_hand;
my @p5_hand;
my @p6_hand;
my @p7_hand;
my @p8_hand;
my @p9_hand;
my @p10_hand;
push (@p2_hand, pop @shuffled_deck);
push (@p3_hand, pop @shuffled_deck);
push (@p4_hand, pop @shuffled_deck);
push (@p5_hand, pop @shuffled_deck);
push (@p6_hand, pop @shuffled_deck);
push (@p7_hand, pop @shuffled_deck);
push (@p8_hand, pop @shuffled_deck);
push (@p9_hand, pop @shuffled_deck);
push (@p10_hand, pop @shuffled_deck);
push (@p2_hand, pop @shuffled_deck);
push (@p3_hand, pop @shuffled_deck);
push (@p4_hand, pop @shuffled_deck);
push (@p5_hand, pop @shuffled_deck);
push (@p6_hand, pop @shuffled_deck);
push (@p7_hand, pop @shuffled_deck);
push (@p8_hand, pop @shuffled_deck);
push (@p9_hand, pop @shuffled_deck);
push (@p10_hand, pop @shuffled_deck);
#Now we want to burn, flop, burn, turn & river...
my @flop;
pop @shuffled_deck;
push(@flop, pop @shuffled_deck);
push(@flop, pop @shuffled_deck);
push(@flop, pop @shuffled_deck);
pop @shuffled_deck;
push(@flop, pop @shuffled_deck);
pop @shuffled_deck;
push(@flop, pop @shuffled_deck);
# Now the grading subroutine must be used to get the
# rankings of the pocket/flop
# combinations for each player, selecting the best in
# each case.
my @players_scores;
my @scores = split //, (rank(@hand, @flop));
$players_scores[0] = rank (@p2_hand, @flop);
$players_scores[1] = rank (@p3_hand, @flop);
$players_scores[2] = rank (@p4_hand, @flop);
$players_scores[3] = rank (@p5_hand, @flop);
$players_scores[4] = rank (@p6_hand, @flop);
$players_scores[5] = rank (@p7_hand, @flop);
$players_scores[6] = rank (@p8_hand, @flop);
$players_scores[7] = rank (@p9_hand, @flop);
$players_scores[8] = rank (@p10_hand, @flop);
# Create some variables for use in the ranking
# mechanism...
my $wurble;
my @thingy;
foreach $wurble(@players_scores)
{
@thingy = split //, $wurble;
if ($thingy[0] , $myscores[0])
{
++$win;
}
elsif ($thingy[0] == $myscores[0])
{
if ($thingy[1] lt $myscores[1])
{
++$win;
}
if ( $thingy[1] eq $myscores[1]
and $thingy[2] lt $myscores[2])
{
++$win;
}
if ( $thingy[1] eq $myscores[1]
and $thingy[2] eq $myscores[2]
and $thingy[3] lt $myscores[3])
{
++$win
}
if ( $thingy[1] eq $myscores[1]
and $thingy[2] eq $myscores[2]
and $thingy[3] eq $myscores[3]
and $thingy[4] lt $myscores[4])
{
++$win
}
if ( $thingy[1] eq $myscores[1]
and $thingy[2] eq $myscores[2]
and $thingy[3] eq $myscores[3]
and $thingy[4] eq $myscores[4]
and $thingy[5] lt $myscores[5])
{
++$win
}
# NB - Count split pot as a win...
if ( $thingy[1] eq $myscores[1]
and $thingy[2] eq $myscores[2]
and $thingy[3] eq $myscores[3]
and $thingy[4] eq $myscores[4]
and $thingy[5] eq $myscores[5])
{
++$win
}
}
else
{
$win = 0;
}
}
if ($win == 9)
{
$win = 0;
++$wins;
}
else
{
$win = 0;
}
open RESULTS, ">> resultlog" or die ("Can't open logfile.");
print RESULTS "Flop: @flop, MyHand: @hand, Others:@p2_hand, @p3_hand
+, @p4_hand, @p5_hand,
@p6_hand, @p7_hand, @p8_hand, @p9_hand, @p10_hand.\n";
print RESULTS "Total Wins: $wins\n";
close RESULTS;
}
$wins /= $iterations;
print "\nWins: $wins %\n";
sub rank
{
my $bar;
my $card;
my @cardlist;
foreach $card(@_)
{
push (@cardlist, $card);
}
# Now produce all 21 possible pocket/flop combinations
my @combs;
$combs[0] = ($cardlist[2].$cardlist[3].$cardlist[4]. $cardlist[5]. $
+cardlist[6]);
$combs[1] = ($cardlist[0].$cardlist[3].$cardlist[4]. $cardlist[5]. $
+cardlist[6]);
$combs[2] = ($cardlist[0].$cardlist[2].$cardlist[4]. $cardlist[5]. $
+cardlist[6]);
$combs[3] = ($cardlist[0].$cardlist[2].$cardlist[3]. $cardlist[5]. $
+cardlist[6]);
$combs[4] = ($cardlist[0].$cardlist[2].$cardlist[3]. $cardlist[4]. $
+cardlist[6]);
$combs[5] = ($cardlist[0].$cardlist[2].$cardlist[3]. $cardlist[4]. $
+cardlist[5]);
$combs[6] = ($cardlist[1].$cardlist[3].$cardlist[4]. $cardlist[5]. $
+cardlist[6]);
$combs[7] = ($cardlist[1].$cardlist[2].$cardlist[4]. $cardlist[5]. $
+cardlist[6]);
$combs[8] = ($cardlist[1].$cardlist[2].$cardlist[3]. $cardlist[5]. $
+cardlist[6]);
$combs[9] = ($cardlist[1].$cardlist[2].$cardlist[3]. $cardlist[4]. $
+cardlist[6]);
$combs[10] = ($cardlist[1].$cardlist[2].$cardlist[3]. $cardlist[4].
+$cardlist[5]);
$combs[11] = ($cardlist[0].$cardlist[1].$cardlist[2]. $cardlist[3].
+$cardlist[4]);
$combs[12] = ($cardlist[0].$cardlist[1].$cardlist[2]. $cardlist[3].
+$cardlist[5]);
$combs[13] = ($cardlist[0].$cardlist[1].$cardlist[2]. $cardlist[3].
+$cardlist[6]);
$combs[14] = ($cardlist[0].$cardlist[1].$cardlist[2]. $cardlist[4].
+$cardlist[5]);
$combs[15] = ($cardlist[0].$cardlist[1].$cardlist[2]. $cardlist[4].
+$cardlist[6]);
$combs[16] = ($cardlist[0].$cardlist[1].$cardlist[2]. $cardlist[5].
+$cardlist[6]);
$combs[17] = ($cardlist[0].$cardlist[1].$cardlist[3]. $cardlist[4].
+$cardlist[5]);
$combs[18] = ($cardlist[0].$cardlist[1].$cardlist[3]. $cardlist[4].
+$cardlist[6]);
$combs[19] = ($cardlist[0].$cardlist[1].$cardlist[3]. $cardlist[5].
+$cardlist[6]);
$combs[20] = ($cardlist[0].$cardlist[1].$cardlist[4]. $cardlist[5].
+$cardlist[6]);
# Now cycle through each of the possible combinations and
# give it a ranking
# rankings go from 1 (lowest - high card) to
# 9 (highest - running flush)
# plus the values of high cards to split similar scores,
# such as the values
# of the pairs in two pair...
my @rankings;
my $quin;
foreach $quin(combs)
{
# Split the quintet into its component cards and suits,
# which allows
# easier detection of the various possible hands...
my $values = join '', (split/\d+/, $quin);
my $suits = join '', (split /\D+/, $quin);
# Now get sorted values so that straights are easy to
# find...
my $sorted_values = join '', reverse sort(split/\d+/, $quin);
# Now build a a unique list for future use, which has
# certain properties
# which prove useful...
my $value;
my %unique;
my @list = split //, $sorted_values;
foreach $value(@list)
{
$unique{value} = 1;
}
my @unique_list = reverse sort keys %unique;
# Now look for running flushes...
if (( $suits == '11111'
or $suits == '22222'
or $suits == '33333'
or $suits == '44444')
and
( $sorted_values eq 'abcde'
or $sorted_values eq 'bcdef'
or $sorted_values eq 'cdefg'
or $sorted_values eq 'defgh'
or $sorted_values eq 'efghi'
or $sorted_values eq 'fghij'
or $sorted_values eq 'ghijk'
or $sorted_values eq 'hijkl'
or $sorted_values eq 'ijklm'))
{
my $result = '9'.substr($sorted_values, 0, 1);
push (@rankings, $result);
next;
}
# Okay, time for four of a kind...
if ( $sorted_values =~ m/a{4}/
or $sorted_values = ~m/b{4}/
or $sorted_values = ~m/c{4}/
or $sorted_values = ~m/d{4}/
or $sorted_values = ~m/e{4}/
or $sorted_values = ~m/f{4}/
or $sorted_values = ~m/g{4}/
or $sorted_values = ~m/h{4}/
or $sorted_values = ~m/i{4}/
or $sorted_values = ~m/j{4}/
or $sorted_values = ~m/k{4}/
or $sorted_values = ~m/l{4}/
or $sorted_values = ~m/k{4}/)
{
my $result = '8'.substr($sorted_values, 2, 1);
foreach $value(@unique_list)
{
if ($value ne substr($result, 1, 1))
{
$result .= $value;
}
push (@rankings, $result);
next
}
}
# Full houses, which have the property that the unique
# list can only contain two
# values (as do 4 of a kinds, which have already been
# eliminated) hencethis provides
# us with an easy way of finding them....
if (scalar(@unique_list) == 2)
{
my $result = 7;
# Now go through the sorted list, finding the correct
# values to append to $result
# noting that the triplet must come first (which is
# why we cannot just append
# the value from the unique list.)
foreach $value(@unique_list)
{
if ($sorted_values =~ m/$value{3}/)
{
$result .= $value;
my $pair_value;
foreach $pair_value(@unqiue_list)
{
if ($pair_value ne $value)
{
$result = .= $pair_value;
}
}
}
}
push (@rankings, $result);
next;
}
# Now flushes (fairly easy)...
if ( $suits == '11111'
or $suits == '22222'
or $suits == '33333'
or $suits == '44444')
{
my $result = '6'.substr($sorted_values, 0, 1);
push (@rankings, $result);
next;
}
# Now for unsuited straights (not too difficult...
if ( $sorted_values eq 'abcde'
or $sorted_values eq 'bcdef'
or $sorted_values eq 'cdefg'
or $sorted_values eq 'defgh'
or $sorted_values eq 'efghi'
or $sorted_values eq 'fghij'
or $sorted_values eq 'ghijk'
or $sorted_values eq 'hijkl'
or $sorted_values eq 'ijklm')
{
my $result = '5'.substr($sorted_values, -1);
push (@rankings, $result_;
next;
}
# And 3-of-a-kind...
if ( $sorted_values =~ m/a{3}/
or $sorted_values = ~m/b{3}/
or $sorted_values = ~m/c{3}/
or $sorted_values = ~m/d{3}/
or $sorted_values = ~m/e{3}/
or $sorted_values = ~m/f{3}/
or $sorted_values = ~m/g{3}/
or $sorted_values = ~m/h{3}/
or $sorted_values = ~m/i{3}/
or $sorted_values = ~m/j{3}/
or $sorted_values = ~m/k{3}/
or $sorted_values = ~m/l{3}/
or $sorted_values = ~m/k{3}/)
{
# Now get the return value - note that in any three
# of a kind stored in order, the
# middle card ALWAYS forms part of the triplet
# irrespective of the other values...
my $result = '2'.substr($sorted_values, 2, 1);
for ($bar = 0; ($bar + 1); ++$bar;)
{
$value = substr($sprted_values, $bar, 1);
if ($value ne sunstr($result, 1, 1)
{
$result .= $value;
}
}
push (@rankings, $result);
next;
}
# Now for 2 pairs, which is trickier because of the
# possible patterns...
# OTOH the Unique List property come into play once
# again...
if (scalar(@unique_list) == 3)
{
my $result = '3';
# Now go through the unique list, finding the pairs
# on sorted_list...
foreach $value(@unique_list)
{
if ($sorted_values =~ m/$value{2}/)
{
$result .= $value;
}
}
foreach $value(@unique_list)
{
if ( $value ne substr($result, 1, 1)
and $value ne substr($result, 2, 1))
{
$result .= $value;
}
}
}
# And now for the technically far easier onw pair....
if ( $sorted_values =~ m/a{2}/
or $sorted_values = ~m/b{2}/
or $sorted_values = ~m/c{2}/
or $sorted_values = ~m/d{2}/
or $sorted_values = ~m/e{2}/
or $sorted_values = ~m/f{2}/
or $sorted_values = ~m/g{2}/
or $sorted_values = ~m/h{2}/
or $sorted_values = ~m/i{2}/
or $sorted_values = ~m/j{2}/
or $sorted_values = ~m/k{2}/
or $sorted_values = ~m/l{2}/
or $sorted_values = ~m/k{2}/)
{
my $result = '2';
foreach $value(@unique_list)
{
if ($sorted_values =~ m/$value{2}/)
{
$result .= $value;
}
}
foreach $value(@unique_list)
{
if ($value ne substr($result, 1, 1))
{
$result .= $value;
}
}
push (@rankings, $result);
next;
}
# Last option, high cards...
my $result ='1';
foreach $value(@sorted_values)
{
$result .= $value;
}
push (@rankings, $result);
}
# We should now have a list of the values of each
# possible hand, which we'll sort
# and then return the highest (probably very
# inefficiently!)
my @winner;
my $value;
my @hand_rank;
foreach $value(@rankings)
{
@hand_rank = split //, $value;
if ($hand_rank [0] > $winner)
{
$winner[0] = $hand_rank[0];
$winner[1] = $hand_rank[1];
$winner[2] = $hand_rank[2];
$winner[3] = $hand_rank[3];
$winner[4] = $hand_rank[4];
$winner[5] = $hand_rank[5];
}
elsif ($hand_rank[0] == $winner[0])
{
if ($hand_rank [1] gt $winner[1])
{
$winner[0] = $hand_rank[0];
$winner[1] = $hand_rank[1];
$winner[2] = $hand_rank[2];
$winner[3] = $hand_rank[3];
$winner[4] = $hand_rank[4];
$winner[5] = $hand_rank[5];
}
elsif ( $hand_rank[1] eq $winner[1]
and $hand_rank[2] gt $winner[2])
{
$winner[0] = $hand_rank[0];
$winner[1] = $hand_rank[1];
$winner[2] = $hand_rank[2];
$winner[3] = $hand_rank[3];
$winner[4] = $hand_rank[4];
$winner[5] = $hand_rank[5];
}
elsif ( $hand_rank[1] eq $winner[1]
and $hand_rank[2] eq $winner[2]
and $hand_rank[3] gt $winner[3])
{
$winner[0] = $hand_rank[0];
$winner[1] = $hand_rank[1];
$winner[2] = $hand_rank[2];
$winner[3] = $hand_rank[3];
$winner[4] = $hand_rank[4];
$winner[5] = $hand_rank[5];
}
elsif ( $hand_rank[1] eq $winner[1]
and $hand_rank[2] eq $winner[2]
and $hand_rank[3] eq $winner[3]
and $hand_rank[4] gt $winner[4])
{
$winner[0] = $hand_rank[0];
$winner[1] = $hand_rank[1];
$winner[2] = $hand_rank[2];
$winner[3] = $hand_rank[3];
$winner[4] = $hand_rank[4];
$winner[5] = $hand_rank[5];
}
elsif ( $hand_rank[1] eq $winner[1]
and $hand_rank[2] eq $winner[2]
and $hand_rank[3] eq $winner[3]
and $hand_rank[4] eq $winner[4]
and $hand_rank[5] eq $winner[5])
{
$winner[0] = $hand_rank[0];
$winner[1] = $hand_rank[1];
$winner[2] = $hand_rank[2];
$winner[3] = $hand_rank[3];
$winner[4] = $hand_rank[4];
$winner[5] = $hand_rank[5];
}
}
}
my $answer = join '', @winner;
return ($answer);
}
"Rule #17 of Travel: Never try and score dope off Hassidic Jews while under the impression that they are Rastafarians."
- Pete McCarthy, McCarthy's Bar