my %cardvals;
%cardvals{ @hand[0..4]<num> }++
[download]

# [234] of a kind
$score += [*]($_,$_-1) for %cardvals.values;
[download]

# Fifteens
if any( @hand<val> ) ~~ 5 && any( @hand<val> ) ~~ 10 {
    $score += 2 *
        ( grep -> $_<val> ~~ 5, @hand ) *
        ( grep -> $_<val> ~~ 10, @hand );
}
[download]

# Runs
SPAN: for 5 .. 3 -> $span {
    for 1 .. 11 -> $start {
        if all( @cardvals{ $start .. $start + $span } ) {
            $score += $span;
            last SPAN;
        }
    }
}
[download]

Hand = 2,3,3,4 5

2,3,4,5 = 4 points
2,3,4,5 = 4 points
        = 8 points total
[download]

Cool. Thanks for replying. :-) A few fixes, then.

You're absolutely right on the runs. Rewrite it as such:

# Runs
SPAN: for 5 .. 3 -> $span {
    for 1 .. 11 -> $start {
        if all( @cardvals{ $start .. $start + $span } ) {
            $score += $span [*] %cardvals{ $start .. $start + $span};
            last SPAN;
        }
    }
}
[download]

Since %cardvals contains the number of each card, that's the number of times the run should be multiplied by. This also correctly handles 2,3,3,4,4. The span is 3 and the multiplier is 1*2*2, which results in 12.

Update: I'm a little reduce-happy. That should really be:$score += $span *<< %cardvals{ $start .. $start + $span};

You're also absolutely right on the fifteens. There are probably several ways to solve it. There's the brute-force method you used, which is perfectly adequate. However, I think we can use junctions to solve our problem. (Junctions rock, you know.)

# Fifteens
$score += 2 * all( 15 == [+]@hand{ any( 0 .. 4 ) } };
[download]

I'm not sure that's legal. I've cross-posted it to P6L for @Larry to rip apart.

Update: After japhy's comments, it should probably look something like:

# Fifteens
$score += 2 * all( 15 == [+]%hand{ any( 0 .. 4 ) } )>>.<num>;
[download]

I'm trying to figure out the correct way to handle the combinations as a single item.

---

• 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?"

I don't know entirely how things work, but I think your bottom code has some flaws. First, does all() return the number of elements in the junction in scalar context? If so, then that's ok.

Second, is it %hand or @hand? You're missing the array sigil with hash-slice syntax.

Third, I think any(0..4) isn't good enough. That's only good for getting individual elements, I think. You need something that returns (0 | 1 | 2 | 3 | 4 | (0,1) | (0,2) | (0,3) | (0,4) | (1,2) | (1,3) | (1,4) | (2,3) | (2,4) | (3,4) | (0,1,2) | (0,1,3) | (0,1,4) | (0,2,3) | (0,2,4) | (0,3,4) | (1,2,3) | (1,2,4) | (1,3,4) | (2,3,4) | (0,1,2,3) | (0,1,2,4) | (0,2,3,4) | (1,2,3,4)). I don't know offhand how to use any() and all() to achieve that.

---

Jeff japhy Pinyan, P.L., P.M., P.O.D, X.S.: Perl, regex, and perl hacker
How can we ever be the sold short or the cheated, we who for every service have long ago been overpaid? ~~ Meister Eckhart

sub gen_idx_powerset (Int $size is copy) returns Array {
    my @c = ([]);
    for 0 .. $size-1 -> $i {
        push @c, (map { [@$_, $i] }, @c);
    }
    return @c;
}

# Fifteens
$score += 2 * grep {
    15 == [+]( @hand[@$_]>>.<val> )
}, gen_idx_powerset( +@hand );
[download]

Notes:
• I'm still trying to figure out a way of generating the powerset of indices without needing the for-loop, but it's an iterative process that needs the list from the prior iteration to work. So, I'm not sure if that's possible.
• I don't know if the parentheses around @hand[@$_]>>.<val> are needed.
• I don't know if it's @hand[@$_] or @hand[$_]. I hope it's the former, but there's some weird stuff about promoting array references in a DWIM-ish fashion which I haven't understood. So, you may be able to golf another character.
• gen_idx_powerset() will return the powerset with the empty set first. Add a reverse if you want to use that as a for-loop. It should also be trivial to convert that into an iterator with gather-take or some similar construct.
• Yes, gen_idx_powerset() is a very elegant algorithm when done recursively. That's not how it came to me at midnight last night, though. I don't think that the tail-call optimization in P6 will help much, and the recursion isn't parallelizable because of the dependence on the prior iteration's results.

  sub gen_idx_powerset( Int $i is copy ) {
      return [] unless $i > 0;
      return (
          gen_idx_powerset( $i - 1 ),
          (map { [@$_, $i] }, gen_idx_powerset( $i - 1 ) ),
      );
  }
  [download]

---

• 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?"

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;
}
[download]

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.

Cheers - L~R