use v6; my @deck = new_deck(); my $next = combo(5, @deck); my @combo; while ( @combo = $next() ) { # Skip all hands that do not contain a 5 next if ! grep { $_ == 5 } @combo; # Skip all hands that have a score of at least 2 my $score = score( @combo ); next if $score > 1; # Print out the rest say join ' ', $score, map -> $_ { $_ ~ $_ } @combo; } sub score ( @hand ) returns Int { my $score = 0; # Last card is always cut card (for purposes of right-jack and flush) # [234] of a kind my %of_a_kind = (1 => 0, 2 => 2, 3 => 6, 4 => 12); my %seen; for ( map -> $_ { $_ } @hand ) { %seen{$_}++; } for ( values %seen ) { $score += %of_a_kind{$_} } # Flush my %suit = map -> $_ { $_ => 1 } @hand[0 .. 3]; $score += 4 if +%suit == 1; $score++ if %suit{ @hand[ -1 ] }; # Count 15's my @vals = map -> $_ { $_ } @hand; for ( 2 .. 5 ) { my $next = combo($_, @vals); my @combo; while ( @combo = $next() ) { my $tot = 0; for ( @combo ) { $tot += $_ } $score += 2 if $tot == 15; } } # Check for right-jack for ( @hand[0 .. 3] ) { if ( $_ eq 'J' ) { if ( $_ eq @hand[ -1 ] ) { $score++; last; } } } # Check for runs my @nums = map -> $_ { $_ } @hand; my $found; for ( 5, 4, 3 ) { last if $found; my $next = combo($_, @nums); my @combo; while ( @combo = $next() ) { @combo = sort { $^a <=> $^b } @combo; my ($prev, $in_sequence) = (0, 1); for ( @combo ) { if ( ! $prev ) { $prev = $_; next; } if ( $_ - $prev != 1 ) { $in_sequence = 0; last; } $prev = $_; } if ( $in_sequence ) { $found = 1; $score += $_; } } } return $score; } sub combo (Int $by is copy, @list is copy) returns Ref { my @position = 0 .. ($by - 2), $by - 2; my @stop = @list.elems - $by .. @list.end; my $done = undef; return sub { return () if $done; my $cur = @position.end; while ( ++@position[ $cur ] > @stop[ $cur ] ) { --$cur; @position[ $cur ]++; next if @position[ $cur ] > @stop[ $cur ]; my $new_pos = @position[ $cur ]; @position[ $cur .. @position.end ] = $new_pos .. ($new_pos + $by); last; } $done = 1 if @position[ 0 ] == @stop[ 0 ]; return @list[ @position ]; }; } sub new_deck () returns Array { my @deck; my %val = map -> $_ { $_ => $_ } 1..10; %val{ 11..13 } = (10) xx 3; my %disp = map -> $_ { $_ => $_ } 2..10; %disp{ 1, 11..13 } = qw; for ( 1..13 ) { push @deck, { 'num' => $_, 'val' => %val{$_}, 'suit' => 'H', 'disp' => %disp{$_} }, { 'num' => $_, 'val' => %val{$_}, 'suit' => 'D', 'disp' => %disp{$_} }, { 'num' => $_, 'val' => %val{$_}, 'suit' => 'C', 'disp' => %disp{$_} }, { 'num' => $_, 'val' => %val{$_}, 'suit' => 'S', 'disp' => %disp{$_} }, } return @deck; }