Cribbage Scoring

It’s something that’s always nagged me. When it gets complicated I usually do it incorrectly—score cribbage hands. When you score car license plates according to cribbage rules trust me it gets complicated. A conversation with my friend, and former computer science nerd (possibly still one), Andrea proved that the algorithm for scoring cribbage hands might not be that hard. This post will attempt to bore my non-computer science friends as I explain the algorithms I used and how I wrote it in Perl.

I don’t want to get into the details of how to play cribbage, I’ll limit it to just tallying your own cribbage hand. Points are gathered in three ways:

• Runs of three or more cards.
• Pairs of two.
• Sets of cards summing to 15.

The points gathered in each of these ways is slightly different:

• the length of the run is the number of points gathered.
• each pair is worth 2 points.
• each group of cards summing to 15 points is worth 2 points.

Examples always makes things clearer:

• 2 3 4 = 3 points
• 2 2 = 2 points
• 7 8 = 2 points
• 2 3 3 4 = 8 points (two runs of three plus one pair)
• 6 7 8 9 = 8 points (one runs of four plus two groups of cards summing to 15)
• 5 5 5 5 = 20 points (four sets summing to 15 for eight points and six pairs for twelve)

I approached this problem by breaking the algorithm down into it’s component parts—computing pairs, runs and groups of 15.

Scoring Pairs

Scoring pairs turns out to be the easiest of all the scoring methods. Scoring runs and scoring sets of 15 is too complicated and probably would encourage check your email and eventually lose interest!

I presented a hand of cribbage cards as an array of cards. The suit of the card doesn’t really matter, so I’ll only store the value of the card in the array. To make the algorithm easier the array is sorted in ascending order. This simplifies this scoring algorithm and others.

What we are looking for is a way to compute all pairs of two cards. To do this I use two loops, one loop over all but the last element in the array and a nested loop from the next element to the end of the array. Basically the first loop isolates one element and the second loop searches for matches among the remaining elements. Every match is a pair worth two points:

sub ScorePairs {
    my $handRef = shift;
    my @hand = @$handRef;
    my $ret = 0;

    for(my $pos = 0; $pos < int(@hand) - 1; $pos++) {
        my $val = $hand&#91;$pos&#93;;
        for(my $ppos = $pos + 1; ($ppos < int(@hand)) && ($hand&#91;$ppos&#93; == $val); $ppos++) {
            $ret += $PAIR_PTS;
        }
    }
    return $ret;
}&#91;/sourcecode&#93;
I won’t get into the details of what’s being passed in—what’s important is the hand of cards that’s passed in is copied into the array @hand.Another way of writing this is scan the array and compute the total number of each card type—it’s not important what type it is. From that use the <a href="http://www.mathwords.com/c/combination_formula.htm">combination formula</a> formula, nCr, where n is the number of a particular card type and r is two. Repeat this for every card type and multiply by two to generate the score for your pairs. Heck..that might have been easier, it wouldn’t have been O(n**2), rather it be O(n).<P>

<b>Scoring Runs</b><P>

Computing runs are made easier by sorting the array earlier of cards. But nonetheless not simple because one duplicate card in the run doubles the value of the run. The hand “1 2 3” is worth three points. The hand “1 2 2 3” is worth 8 points ( two runs of three plus the pair). So how to handle this? The solution I came up with is probably not terribly efficient but, it works.
I walk the array increasing a length variable for every adjacent cards with a difference of one. When there is a matching pair of cards, I increase a multiplier by one (initially set to 1), and move to the next card not increasing the length at all. When two adjacent cards are encountered that are neither equal nor have a difference of one, the run has ended and the total score of the run is computed. The score is the length * the multiplier. In the case of “1 2 2 3” the when the end of the array is reached the the score is, 3 * 2, length of 3, multiplier of 2 because two “2s” where found.Wait..what about the hand “1 1 2 2 3”? Is the score 3 * 3 for 9 points (let’s ignore pairs for now). No, sadly that’s wrong. There are four runs of 3 [BTW when should I write 'three' instead of the digit '3'? Sorry for the inconsistencies in this post!]. Herumph! The cardinality of each group of equal cards in a run, is a multiplier of the run. What the heck does that mean? In the example above, “1 1 2 2 3”, there are two groups of equal cards in the run, (1, 1) and (2, 2). Each one generates a multiplier of 2. So the total multiplier is 4. Let’s look at the Perl code:
<b></b>

sub ScoreRuns {
    my $hand = shift;

    my $len = 1;
    my @mult = ( 1 );
    my $ret = 0;
    my @cards = @$hand;

    for(my $pos = 0; $pos = $MIN_RUN_LENGTH ) {
                $ret += $len * ComputeMult(\@mult);
                $len = 1; # reset and move on
                @mult = ( 1 );
            }
        }
    }
    # could exit loop at end of valid run.
    if ( $len >= $MIN_RUN_LENGTH ) {
        $mult = ComputeMult(\@mult);
        $ret += ($len * $mult);
    }
    return $ret;
}

Key to understanding how this works is the multiplier vector. Anytime a non-duplicate is encountered in the hand, a “1” is pushed onto the multiplier vector. If the next card is a duplicate, the current multiplier entry is increased by one. When a run of cards ends the length of the run is multiplied by all the elements in the multiplier vector. Since a new run is starting, the length is reset to 0 and the multiplier vector reset to just the value 1. Let’s look at an example:array: 1 2 2 3 5 6 6 7Scoring only runs, the total number if points in this hand is 12. Why? There are 4 runs of three. There are two places the runs end—between the 3 and 5, and between the 7 and the end of the array. The multiplier vector is (1 2 1) when the 5 is reached. So the multiplier vector times the length, 3, is 1 * 2 * 1 * 3 which is 6. At the end of the array the current run is scored and it is the same as the previous computation 1 * 2 * 1 * 3 = 6. The total points is therefore 12. This portion of the algorithm is O(n). Fun!

Scoring Combos

I don’t know if combos is the right term. Really we’re scoring groups of cards that sum to a particular value. Saying combos, however, sounds cool.Anyway, scoring combos is really a depth first search for groups where the sum is a particular value. Again the algorithm is simplified by the cards being sorted—we can cut off the search when adding a card exceeds the sum amount (again 15 for cribbage). I wrote it originally in C because I found it easier to write using pointer arithmetic:

int work(int array[], int sum) {
  int runningscore = 0;
  if ( sum == 15 ) {
    return 2;
  }
  else if ( *array == -1 ) {
    return 0;
  }
  else if ( sum > 15 ) {
    return 0;
  }
  else {
    for(; *array != -1; array++) {
      runningscore += work(array+1, sum + *array);
    }
  }
  return runningscore;
}

There are three terminating base cases:

• the sum of the set is 15.
• you reach the end of the array (in this example I pad the end of the array with a -1 so I don’t have to track the size of the array).
• the sum of the group is greater than 15.

The inductive step is looping through the entire array recursively calling the score function on each of the elements.

I was having problems translating it to Perl, mostly I think because of getting the array slices correct. Then Andrea suggested (I don’t know if jokingly) writing it in Lisp. Hmm…why not?

(defun score (list sum)
  (cond
    ((= sum 15) 2)
    ((> sum 15) 0)
    ((null list) 0)
    (t
      (+ (score (cdr list) (+ sum (car list))) (score (cdr list) sum))))

I think this is right—I haven’t tested it but what’s important here is the lack of iteration! Using a loop in Lisp is a sin so I called score recursively on the remainder of the list:

(+ (score (cdr list) (+ sum (car list))) (score (cdr list) sum))))

Note that I’m not modifying the sum, I’m just skipping the head of the list by passing the remainder of the list to the score function. So, I should be able to rewrite that C function to not use iteration:

int work(int array[], int sum) {
  int runningscore = 0;
  if ( sum == 15 ) {
    return 2;
  }
  else if ( *array == -1 ) {
    return 0;
  }
  else if ( sum > 15 ) {
    return 0;
  }
  else {
    runningscore += work(array+1, sum + *array) + work(array+1, sum);
  }
  return runningscore;
}

OK, so how does this translate to Perl?

sub ScoreComboWork {
  my $sum = shift;
  my $combo_sum = shift;
  my @hand = @_;</span>

  my $runningScore = 0;

  return 2 if ( $sum == $combo_sum );
  return 0 if ( $sum > $combo_sum );
  return 0 if ( @hand == 0 );

  my @subarray = @hand[1..$#hand];
  $runningScore += ScoreComboWork($sum + $hand[0], $combo_sum, @subarray)
                           + ScoreComboWork($sum, $combo_sum, @subarray);
  return $runningScore;
}

The equivalent of the lisp cdr function is the array hash from 1 to the end of the array which is assigned to @subarray.What is the big-O notation for this algorithm. Hmm..I think it’s O(n*2). Why? In the worst case this will through every element and then within that from the next element to the end of the array. Classic nested loops.

bad code?

I’m working getting Jay Fenalson’s hack up and running on OS X Leopard. While debugging the code I ran into this sample code that exemplifies Jay’s coding style which I really don’t like:

for(foo=(int *)levl; foo <= (int *)&levl[NX-1][NY-1]; *foo++ = 0)

Take a good look at that. What the heck is going on? Well, he’s converting levl, which is of type:

struct lev levl[NX][NY];

So really levl is type struct lev ** (well, sizeof would disagree about this as levl is a specific size but for the sake of this discussion struct lev ** is fine). Well, he’s type casting that to int * and putting that into foo. I’ll cover the incr part of the foo loop explaining the test.  He’s checking to make sure foo, which contains the address of an array of lev structures–remember each element of the array is a pointer, doesn’t run off the end of the array of levels.  OK, back to incr expr of the for loop,  *foo++ = 0.  John Ousterhoot said that parenthesis should be added when the order of operations is not clear. Is it clear here?   Obviously the intent is to null the array, the deref occurs first then the assignment and finally the increment (actually the generated code copies foo to a tmp, increments foo and then uses tmp for the deref and then assignment).  Precedence aside,  wouldn’t the code be easier to read if it was:

*foo = 0, foo++;

The comma operator in C, evaluates multiple statements as one statement, using the last statement as the return value.

This is how I tend to write and therefore teach people Perl. Although there is more than one way to do it, it’s not necessarily the right way. Write it readable and  let the compiler take care of the rest. If it’s still too slow, and most likely it isn’t, then go back and optimize.