in reply to Re: Perl6 Contest: Test your Skills
in thread Perl6 Contest: Test your Skills

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> }++
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;
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 ); }
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; } } }
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
Your approach aborts after the first run is found.

Cheers - L~R

Replies are listed 'Best First'.
Re^3: Perl6 Contest: Test your Skills
by dragonchild (Archbishop) on May 25, 2005 at 17:26 UTC
    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; } } }
    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 ) } };
    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>;
    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
Re^3: Perl6 Contest: Test your Skills
by dragonchild (Archbishop) on May 26, 2005 at 13:17 UTC
    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 );
    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 ) ), ); }

    • 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; }
      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

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