#! /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);
}