Just to get the party started, and without putting much effort into it, you can change this:

    next if ! grep { $_<val> == 5 } @combo;
[download]

to:

    next if none(@a) == 5;
[download]

Update: another quick note. Your iterator should be able to be nicely implemented in terms of gather/take. Pugs doesn't have it yet, so I haven't had a chance to play with it enough to be very comfortable, but it would be nice if someone could show how to do that. :-)

Another update: here's my crack at gatherifying your combo generator. I dunno if it's right, but it fits my understanding of how the construct is supposed to work:

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;

    gather {
        until $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_p
+os + $by);
                last;
            }
            $done = 1 if @position[0] == @stop[0]; 
            take [ @list[@position] ];
        }
    }
}
[download]

As we can see, this was a very straightforward change. My understanding is that this should act lazilly -- possibly as a coroutine -- if used in a lazy context. Instead of returning lists, I have it take array references, because I'm not sure if taking a list would Do The Right Thing. Again, this is just my understanding of the feature. I could have this all wrong.

Update on another update: added until loop around body of gather. I think it's correct this time. :-)

revdiablo,
Bravo! I intentionally tried to only use things that were not new with p6. Your suggestion is what I would consider "low hanging fruit". There should be plenty of it - which is one purpose of the challenge (getting used to p6isms that make your life easier)!

Cheers - L~R

• If you have a 10, J, Q, or K anywhere in @hand, you win.
• If you have another 5, you win.
• If you have a pair of anything else, you win.
• If you have 3 cards in a row, you win.
• If +%suit{@hand[0..3]} == 1, you win. The suit of the cut-card is irrelevant.
• The check on the right jack is irrelevant because it's the only 1-point item.

So, the trick is to prove you cannot construct a hand and cut-card that do not meet these criteria. A proof by negation, if you will. I will leave that as an exercise for the reader.

dragonchild,
I agree that once you know you have at least 2 points you can give up. If you look at my p5 solution in that thread, I solved the problem in 63 seconds (3 to generate a candidate list and 60 to disqualify them).

That's not the point of this challenge. The challenge is about practicing p6 features and syntax with efficiency only a secondary goal.

Cheers - L~R

This is my point:

# Assumption: @hand[0]<val> == 5;
sub is_good( @hand ) returns Bool {
    # If you have a 10, J, Q, or K anywhere in @hand, you win.
    if any(@hand<val>) == 10 {
        return true;
    }

    # If you have more than one of anything, you win.
    my %cardvals;
    %cardvals{ @hand[0..4]<num> }++;
    if any( %cardvals.values ) > 1 {
        return true;
    }

    # If you have 3+ cards in a row, you win.
    for 1 .. 11 -> $start {
        if all( @cardvals{ ($start, $start+1, $start+2) } ) {
            return true;
        }
    }

    # If +%suit{@hand[0..3]} == 1, you win.
    # Note: The suit of the cut-card is irrelevant.
    my %suits;
    %suits{ @hand[0..3]<suit> }++;
    if +%suit == 1 {
        return true;
    }

    # Alternately, this could have been written:
#    if all( @hand[0..3]<suit> ) == any( @hand[0..3]<suit> ) {
#        return true;
#    }

    return false;
}
[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?"

sub score ( @hand ) returns Int {
    my Int $score = 0;

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

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

    # Flushes
    $score += 4 if @hand[0]<suit> ~~ all( @hand[1..3]<suit> );
    $score++    if @hand[4]<suit> ~~ all( @hand[0..3]<suit> );

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

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

    # Right-Jack
    $score++ if grep ->
        $_<disp> ~~ 'J' && $_<suit> ~~ @hand[4]<suit>, @hand[0..3];

    return $score;
}
[download]

dragonchild,
Sorry it has taken me a while to reply, but I have been trying to track down bugs and add tests for missing features. Several of them prompted by this reply - so thanks!

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

I don't believe @hand[0..4]<num> works. I believe you need the hyper operator for that as in @hand[0..4]>>.<num>. Since the slice represents the entire array it can be dropped all together - @hand>>.<num> I am not sure about the post increment also needing to be distributed either but my hunch is that it should be.

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

Clever! To explain what is happening from right to left: The values of the hash are the counts of each in the hand. The infix operator gets the product of the count and the count minus 1 so ( 1 => 0, 2 => 2, 3 => 6, 4 => 12 ). The result is then added to the current $score.

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

I am fairly certain this is inadequate. Consider 2 + 3 + 6 + 4 = 15. (no fives or tens)

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

Again Clever! In this case though it isn't quite enough. To explain what I believe is going on is that you already have all of the number values stored in a hash. You start looking for runs of 5 then 4 then 3. Then you check for all possible runs of that length by checking if all cards in the hash have a true value. Unfortunately this is where it goes wrong. Consider:

Hand = 2,3,3,4 5

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

Your approach aborts after the first run is found.

Cheers - L~R

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

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

Another low hanging fruit observation. I didn't want to add another update to my already too-updated post, so I posted a new one. All the () around your conditions are unnecessary. For example, you can change:

    while ( @combo = $next() ) {
[download]

To:

    while @combo = $next() {
[download]

(Of course, this ignores the changes I made to the combo sub in my previous post. To take that into account, you would change it to:

    for combo() -> $combo {
[download]

Or something like that.)