in reply to Re^3: Perl6 Contest: Test your Skills
in thread Perl6 Contest: Test your Skills
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.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; }
Cheers - L~R
|
---|
Replies are listed 'Best First'. | |
---|---|
Re^5: Perl6 Contest: Test your Skills
by dragonchild (Archbishop) on May 27, 2005 at 18:02 UTC |