dragonchild,
If you can figure out the proper lazy gather/take approach to turn your recursive function into an iterative one, I would be happy to use it. Until then, I am sticking with iterative translation from p5.
use v6;
# Brute force proof that every cribbage hand with a 5 is >= 2 points
# See http://perlmonks.org/index.pl?node_id=458728 for details
my $next = combo(5, new_deck());
while my @combo = $next() {
# Skip all hands that do not contain a 5
next if none( @combo>>.<val> ) == 5;
# Skip all hands that have a score of at least 2
next if score( @combo ) > 1;
# Print out the rest
say ~@combo>>.<suit>;
}
sub score ( @hand ) returns Int {
my $score = 0;
# [234] of a kind
my %ordval;
for @hand>>.<num> { %ordval{$_}++ };
for %ordval.values { $score += $_ * $_ - 1 }
# Flush
$score += ([eq] @hand[0..3]>>.<suit>)
?? ([eq] @hand[3,4]>>.<suit>) ?? 5 :: 4
:: 0;
# Check for right-jack, @hand[-1] is community card
$score++ if grep { $_<num> == 11 && $_<suit> eq @hand[-1]<suit> }
+@hand[0..3];
# Count 15's
my @vals = @hand>>.<val>;
for 2 .. 5 {
my $next = combo($_, @vals);
while my @combo = $next() { $score += 2 if ([+] @combo) == 15
+}
}
# Runs
SPAN:
for 5, 4, 3 -> $span {
for sort { $^a <=> $^b } %ordval.keys -> $start {
if all( %ordval{$start .. $start + $span} ) > 1 {
$score += [*] %ordval{$start .. $start + $span}, $span
+;
last SPAN;
}
}
}
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 ] {
@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 {
return map -> $num {
map -> $suit {
{ num => $num, val => $num > 10 ?? 10 :: $num, suit => $su
+it }
} <H D C S>;
} 1..13;
}
This node is subject to change if I find that I have improper syntax or if there is a more perl6ish way of doing something. In the near future, I will be adding this as a Pugs Example.
| [reply] [d/l] |
sub gen_idx_powerset (Int $size is copy) returns Array {
my @c = ([]);
for 0 .. $size-1 -> $i {
push @c, (map { [@$_, $i] }, @c);
}
return @c;
}
Converted to gather/take
sub gen_idx_powerset (Int $size is copy) returns Ref {
my @c = ([]);
return gather {
take @c[0];
for 0 .. $size-1 -> $i {
take for map { [@$_, $i] }, gathered;
}
};
}
- In general, if you think something isn't in Perl, try it out, because it usually is. :-)
- "What is the sound of Perl? Is it not the sound of a wall that people have stopped banging their heads against?"
| [reply] [d/l] [select] |