Beaver Bar Camp

I asked the attendees at the Beaver (Corvallis) BarCamp to help me find a sequence of dice faces that meet the unusual conditional probabilities suggested for the DiceRoller part.

To avoid long explanations I described the problem as one of shuffling with constraints:

• Shuffle a deck of cards such that no two adjacent cards have the same rank. For example, no two aces in a row, no two duces, etc.

• Except for the constraint above, make sure that all legal shuffles are equally likely.

The solution that came out of our session was to insert cards from a sorted deck into a shuffled deck, one at a time, at random locations, and each time checking that the one card inserted meet our constraints. If not, we try inserting a little further in the deck and check again.

I adapted the idea to produce this perl program that generates face sequences in a dice rolling simulator. Think of this as a deck with five suits, each with six cards with rank 1 through 6.

    $_="123456"; 
    for $n (1..5) {
      for $i (1..6) {
        $r = int(rand($l=length($_)));
        s/(.{$r})(.*)/$2$1/;
        s/([^$i]{2})([^$i]{2})/$1$i$2/;
      }
    }
    print "$_\n";

• Cut the shuffled deck at a random position, $r

• Insert $i into the reassembled deck at first opportunity.

I wrote the pattern for the second match to look for strings of digits that do not include $i. In my application I don't want a repeat within two cards. I say [^$i] to mean any character other than $i, and then, {2} to mean exactly two characters meeting this constraint.

This longer range duplication is hard to spot by eye. This is the perl program I used to check my results.

    s/(\d)(\d)(\1)/ ($1$2$3) /g

BartMassey pointed out that this algorithm is flawed in a well known way. The search for the first available space will create clusters of values. He suggested the this fix: Repeat the cut when the new card can't be placed in the first position. Don't even look at the second position.

Here is a modified program.

    $_="123456"; 
    for $n (1..5) {
      for $i (1..6) {
        do {
          $r = int(rand($l=length($_)));
          s/(.{$r})(.*)/$2$1/;
        } until s/^([^$i]{2})([^$i]{2})/$1$i$2/;
      }
    }
    print "$_\n";

Here we further analyze sample sequences by factoring each possible digit into a separate line.

Unconstrained.

    616123425324626632215333456335465464114511551224
    .1.1...............1................11..11..1...
    ....2..2..2..2...22..........................22.
    .....3...3......3....333...33...................
    ......4....4............4.....4..4.4..4........4
    ........5...........5....5...5..5......5..55....
    6.6.........6.66..........6....6..6.............

    561365324252626354152614154623543512134142614363
    ..1...............1...1.1.........1.1..1...1....
    .......2.2.2.2......2.......2......2.....2......
    ...3..3........3.............3..3....3.......3.3
    ........4........4.....4..4....4......4.4...4...
    5....5....5.....5..5.....5....5..5..............
    .6..6.......6.6......6.....6..............6...6.

    426531645243561235215416521325412364156324136436
    .....1........1....1..1...1....1....1.....1.....
    .2.......2.....2..2......2..2...2.......2.......
    ....3......3....3..........3.....3.....3...3..3.
    4......4..4..........4........4....4.....4...4..
    ...5....5...5....5..5...5....5.......5..........
    ..6...6......6.........6..........6...6.....6..6