############################################################################# # Perl program by Mark Brader to compute the tables of multi deck # # poker hand probabilities at https://www.pagat.com/poker/probabilities.html # # This program and the tables it produces are in the public domain. # ############################################################################# #!/usr/bin/perl use warnings; use strict; sub ch { # N choose R my ($n, $r) = @_; my $num = my $den = 1; while ($r > 0) { $num *= $n--; $den *= $r--; } return $num / $den; } # probabilities of particular types of hand with $n decks; # $fl = flushes only or ignore flushes sub type_prob { my ($n, $fl) = @_; my $base = ($fl ? 4 : 1); my $deals = ch(52 * $n, 5); $n *= 4 / $base; # Now $n = number of cards of desired rank (& suit if $fl) my @counts = ( 13 * ch($n, 5), # 5 of a kind 13 * ch($n, 4) * 12 * $n, # 4 of a kind 13 * ch($n, 3) * ch(12, 2) * $n**2, # 3 of a kind 13 * ch($n, 3) * 12 * ch($n, 2), # Full house ch(13, 2) * ch($n, 2)**2 * 11 * $n, # 2 pairs 13 * ch($n, 2) * ch(12, 3) * $n**3, # 1 pair ch(13, 5) * $n**5, # Nothing, ignoring straights 10 * $n**5, # Straight ); $counts[6] -= $counts[7]; # Don't double-count straights return map { $_ * $base / $deals } @counts; } # same with infinite number of decks (or equivalently, five 52-sided dice) sub type_inf_prob { my ($fl) = @_; my @numer = ( 1, # 5 of a kind 5 * 12, # 4 of a kind ch(5, 3) * 12 * 11, # 3 of a kind ch(5, 3) * 12, # Full house 5 * (ch(4, 2) / 2) * 12 * 11, # 2 pairs ch(5, 2) * 12 * 11 * 10, # 1 pair 12 * 11 * 10 * 9, # Nothing, ignoring straights 120 * 10 / 13, # Straight ); $numer[6] -= $numer[7]; # Don't double-count straights return map { $_ / ($fl ? 52 : 13)**4 } @numer; } sub tabulate { my ($probs, $names) = @_; my @ret; my @perm = sort { $probs->[$a] <=> $probs->[$b] } (0 .. $#$probs); for (my $i = 0; $i < @$probs; ++$i) { my $j = $perm[$i]; if ($probs->[$j] > 0) { push @ret, sprintf("%10.6f%% %s", 100 * $probs->[$j], $names->[$j]); } } return @ret; } sub main { use constant TOP => 31; # up to 30 decks; 31st position is "infinite" my @basenames = ( "5 of a kind", "4 of a kind", "3 of a kind", # "full house", "2 pairs", "pair", # "nothing", "straight" # ); my $nclass = @basenames; my @names = ((map { "$_ plain" } @basenames), (map { "$_ flush" } @basenames)); for (my $n = 1; $n <= TOP; ++$n) { my @probs; if ($n == TOP) { @probs = (type_inf_prob(0), type_inf_prob(1)); } else { @probs = (type_prob($n, 0), type_prob($n, 1)); } # Don't double-count flushes for (my $i = 0; $i < $nclass; ++$i) { $probs[$i] -= $probs[$i + $nclass]; } print "\n\n** "; if ($n == 1) { print "single deck\n\n"; } elsif ($n == TOP) { print "infinite decks\n\n"; } else { print "$n decks\n\n"; } my @table = tabulate(\@probs, \@names); my @tradnames = (@basenames, "flush", "straight flush"); my @tradprobs = ( @probs[0 .. 7], $probs[10] + $probs[12] + $probs[13] + $probs[14], $probs[15] ); $tradprobs[0] += $probs[8]; $tradprobs[1] += $probs[9]; $tradprobs[3] += $probs[11]; my @tradtable = ("Traditional hands", "", tabulate(\@tradprobs, \@tradnames)); while (@table < @tradtable) { # align tables unshift @table, ""; } while (@table > @tradtable) { push @tradtable, ""; } foreach (my $i = 0; $i < @table; ++$i) { my $line = sprintf(" %-32s %-32s", $table[$i], $tradtable[$i]); $line =~ s/ *$//; print "$line\n"; } } } main();