#!/usr/bin/perl use strict; use warnings; use List::Util 'sum'; my %straight = (3 => \&straight_3, 4 => \&straight_4, 5 => \&straight_5); my @deck = map { (\$_) x 4 } 1 .. 9; push @deck, (10) x 16; my \$iter = combo(5, @deck); my %seen; open(my \$fh, '>', 'crib.dat') or die \$!; my \$n; while (my @hand = \$iter->()) { next if \$seen{"@hand"}++; my %card; ++\$card{\$_} for @hand; my \$score = 0; # Determine if last card is 10 my \$is_10 = \$hand[-1] == 10 ? 1 : 0; # if every card is < 10, calculate 2/3/4 of a kind if (! \$is_10) { \$score += \$_ * (\$_ - 1) for values %card; } # Can't possibly be a flush if 2/3/4 of a kind exceeds 1 pair my \$check_flush = \$score > 2 ? 0 : 1; # if every card is < 10, calculate straights if (! \$is_10) { my @val = sort {\$a <=> \$b} keys %card; my (\$len, \$beg, \$end) = \$straight{@val}->(@val) if @val > 2; # my and if together if (\$len) { \$len *= \$card{\$_} for @val[\$beg .. \$end] } \$score += \$len || 0; } # Calculate 15s my \$fifteen = 0; for (2 .. 5) { my \$next = combo(\$_, @hand); while (my \$sum = sum(\$next->())) { ++\$fifteen if \$sum == 15; } } \$score += 2 * \$fifteen; \$_ = \$_ == 10 ? 'T' : \$_ for @hand; my \$flags = ! \$is_10 && ! \$check_flush ? 0 : \$is_10 && \$check_flush ? 3 : \$is_10 ? 1 : 2; \$score = sprintf("%.2d", \$score); print \$fh join "", @hand, \$flags, \$score; print \$fh "\n" if not ++\$n % 10; } sub straight_3 { return (3, 0, 2) if \$_[1] - \$_[0] == 1 && \$_[2] - \$_[1] == 1; } sub straight_4 { return (4, 0, 3) if \$_[1] - \$_[0] == 1 && \$_[2] - \$_[1] == 1 && \$_[3] - \$_[2] == 1; return (3, 0, 2) if \$_[1] - \$_[0] == 1 && \$_[2] - \$_[1] == 1; return (3, 1, 3) if \$_[2] - \$_[1] == 1 && \$_[3] - \$_[2] == 1; } sub straight_5 { return (5, 0, 4) if \$_[1] - \$_[0] == 1 && \$_[2] - \$_[1] == 1 && \$_[3] - \$_[2] == 1 && \$_[4] - \$_[3] == 1; return (4, 0, 3) if \$_[1] - \$_[0] == 1 && \$_[2] - \$_[1] == 1 && \$_[3] - \$_[2] == 1; return (4, 1, 4) if \$_[2] - \$_[1] == 1 && \$_[3] - \$_[2] == 1 && \$_[4] - \$_[3] == 1; return (3, 0, 2) if \$_[1] - \$_[0] == 1 && \$_[2] - \$_[1] == 1; return (3, 1, 3) if \$_[2] - \$_[1] == 1 && \$_[3] - \$_[2] == 1; return (3, 2, 4) if \$_[3] - \$_[2] == 1 && \$_[4] - \$_[3] == 1; } sub combo { my \$by = shift; return sub { () } if ! \$by || \$by =~ /\D/ || @_ < \$by; my @list = @_; my @position = (0 .. \$by - 2, \$by - 2); my @stop = @list - \$by .. \$#list; my \$end_pos = \$#position; my \$done = undef; return sub { return () if \$done; my \$cur = \$end_pos; { if ( ++\$position[ \$cur ] > \$stop[ \$cur ] ) { \$position[ --\$cur ]++; redo if \$position[ \$cur ] > \$stop[ \$cur ]; my \$new_pos = \$position[ \$cur ]; @position[ \$cur .. \$end_pos ] = \$new_pos .. \$new_pos + \$by; } } \$done = 1 if \$position[0] == \$stop[0]; return @list[ @position ]; } }