Re: calculating cribbage points

Pairs:

my %count;
++$count{$_} foreach @c;

my @pairs = grep { $count{$_} >= 2 } sort { $b <=> $a } @c;
my @kind3 = grep { $count{$_} >= 3 } @pairs;
my @kind4 = grep { $count{$_} >= 4 } @kind3;
[download]

Longest run:

@c = sort { $b <=> $a } @c;

my $lr_len = 0;
my $lr_idx;

my $s = 0;
while ($s <= 4) {
   my $e = $s+1;
   ++$e while $e <= 4 && $c[$e] == $c[$e-1] - 1;
   if ($e-$s > $lr_len) {
      $lr_len = $e-$s;
      $lr_idx = $s;
   }
   $s = $e;
}
[download]

All runs:

@c = sort { $b <=> $a } @c;

my @runs;

my $s = 0;
while ($s <= 4) {
   my $e = $s+1;
   ++$e while $e <= 4 && $c[$e] == $c[$e-1] - 1;
   if ($e-$s > 1) {
      push(@runs, [ map { $c[$_] } $s..$e-1 ]);
      $lr_idx = $s;
   }
   $s = $e;
}

# Sort by length, then by highest.
@runs = sort { @$b <=> @$a || $b->[0] <=> $a->[0] } @runs;
[download]

Comment on Re: calculating cribbage points Select or Download Code

Replies are listed 'Best First'.
Re^2: calculating cribbage points by Limbic~Region (Chancellor) on Mar 31, 2006 at 16:53 UTC
ikegami, Your code: `my %count; ++$count{$_} foreach @c; my @pairs = grep { $count{$_} >= 2 } sort { $b <=> $a } @c; my @kind3 = grep { $count{$_} >= 3 } @pairs; my @kind4 = grep { $count{$_} >= 4 } @kind3;` [download] Can be simplified to: `my ($points, %count); ++$count{$_} for @c; $points += $_ * ($_ - 1) for values %count;` [download] I used this trick and several others in RFC: Cribbage::Hand. Cheers - L~R	[reply] [d/l] [select]
Re^3: calculating cribbage points by ikegami (Patriarch) on Mar 31, 2006 at 19:22 UTC
I don't know cribbage. I didn't even know we were dealing with cribbage. I didn't count the points, just list the pairs. Your code is not so much a simplification as something different.	[reply]
Re^2: calculating cribbage points by dracos (Sexton) on Mar 31, 2006 at 14:48 UTC
I'm sorry could some one explain what is up with the code for runs. I can't get it to work and I am having troubles figuring out how it is suspose to work.	[reply]
Re^3: calculating cribbage points by ikegami (Patriarch) on Mar 31, 2006 at 19:29 UTC
You can't get them to run? Wierd, I've tested them. You shouldn't have any problems. $s is the index of the card at the start of a run. $e is the index of the card one beyond the end of a run. "lr" stands for "longest run". $lr_idx is the index of the card which starts the longest run. $c[$lr_idx] is the face value of the card which starts the longest run. $lr_len is the length of the run, as a number of cards. @runs is an array of runs, where a run is a reference to an array of card face values.	[reply]
Re^2: calculating cribbage points by thor (Priest) on Mar 31, 2006 at 15:07 UTC
The thing about scoring mutiples (pairs, 3-of-a-kind, 4-of-a-kind) in cribbage is that it all just breaks down to scoring pairs. 3-of-a-kind is worth 6 points because there are 3-choose-2 pairs (which is 3) in a 3-of-a-kind. Each pair being worth 2 points yields 6 points total. So, using similar techniques as stated already in this thread, one can generate the set of all pairs and if the two elements in the pair are the same, increment the count of pairs. thor `The only easy day was yesterday`	[reply]