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

}