#!/usr/bin/perl
use strict;
# 'singletonchange' is the value that we change a single 3 or 6 into to
# force applicability of the equal-or-adjacent rule. I've used 1 because
# it's the first number I thought of, but you could equally well make this
# 2, 4, or 5 and the algorithm will work. Try it! (Or make singletonchange
# equal to 3 or 6 and watch us fail.)
my($singletonchange) = 1;
# Puzzle from Lucas Garron via Matt Parker ( youtu.be/xHh0ui5mi_E ):
#
# Can you use the result from three indistinguishable dice to simulate two?
#
# To llustrate the idea, condider the simpler question:
#
# Can you use the result from two indistinguishable dice to simulate one?
#
# The answer is simple: just add their values and if the answer is
# larger than 6, subtract 6:
#
# Roll any of these: -> answer (simulated die)
# 1+6, 2+5, 3+4, 4+3, 5+2, 6+1 -> 1
# 1+1, 2+6, 3+5, 4+4, 5+3, 6+2 -> 2
# 1+2, 2+1, 3+6, 4+5, 5+4, 6+3 -> 3
# 1+3, 2+2, 3+1, 4+6, 5+5, 6+4 -> 4
# 1+4, 2+3, 3+2, 4+1, 5+6, 6+5 -> 5
# 1+5, 2+4, 3+3, 4+2, 5+1, 6+6 -> 6
#
# Part of the reason this solution works is because the answer is invariant
# across different orderings of the two dice: rolling A+B always gives the same
# answer as rolling B+A. (For example, rolling a 3 and a 5 gives the
# same result (a 2) as rolling a 5 and a 3.)
#
# For the original question, we know that it's possible to do *somehow*, if
# only by creating a huge table, like the table above but with 36 "rows",
# each listing 6 of the 3-dice roll outcomes. We know that because the
# indistinguishable sets of 3-dice roll outcomes are all of size 6, 3, or 1
# and these can be grouped together into rows. For example, there are
# six ways to roll a 2, a 3, and a 5; all six of these would go into the same
# row.
my ($unused_header) = q`
With 3 dice there are 216 possibilities, that fall into 56
distinguishability classes:
There are 20 ways (6*5*4 / 1*2*3) to get all 3 dice different,
and each of these happens 6 times out of the 216
There are 30 ways (6*5) to get a pair plus an odd die, and each of
these happens 3 times out of the 216
There are 6 ways to get three-of-a-kind, and each can happen only one way.
It would be nice to emulate two distinguishable dice. This means
having all 36 combinations be distinguishable, not just the 21 that
you get if you don't know which of the two dice was rolled first.
Let's enumerate our 56 classes, together with the simple "modulo sum"
for each:
ms=1 ms=2 ms=3 ms=4 ms=5 ms=6
1 2 3
1 2 4
1 2 5
1 2 6
1 3 4
1 3 5
1 3 6
1 4 5
1 4 6
1 5 6
2 3 4
2 3 5
2 3 6
2 4 5
2 4 6
2 5 6
3 4 5
3 4 6
3 5 6
4 5 6
. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
1 1 2
1 1 3
1 1 4
1 1 5
1 1 6
2 2 1
2 2 3
2 2 4
2 2 5
2 2 6
3 3 1
3 3 2
3 3 4
3 3 5
3 3 6
4 4 1
4 4 2
4 4 3
4 4 5
4 4 6
5 5 1
5 5 2
5 5 3
5 5 4
5 5 6
6 6 1
6 6 2
6 6 3
6 6 4
6 6 5
. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
1 1 1
2 2 2
3 3 3
4 4 4
5 5 5
6 6 6
By staring at this table for a few hours I eventually noticed that I
could get the desired results (6 each of the numbers 1 through 6 in
each column) using the "onn-man-out rule": Look for the two numbers
that are closest to each other (modulo 6), and ignore them, taking the
third. This works perfectly for columns 1, 2, 4, 5. The troublesome 3
and 6 columns never have an odd-man-out, but they can usually be fixed
by finding a lone troublesome 3 or 6, and changing it to a 1!
ms=3or6:
if there is a single 3 or 6, treat that as a 1 and follow the ignore-adjacent rule:
126/123->112->2 ; 135/156->115->5 ; 234/246->124->4 ; 456/345->145->1
if it's all 3's and 6's, or if you rolled 3 of a kind, d2=d1
else d2=9-d1
`;
my($td_extra_actions); # Used to pass extra logging message back to caller
# Ignore the two closest dice (equal, or different by +-1 modulo 6).
# This happens 2/3 of the time.
#
# If there aren't two closest, try to make it so by singling out the
# lone 3 or 6 and making it a 1. This covers 2/3 of the remaining 1/3!
#
# The last 1/9 * 216 = 216/9 = 24 = 3*6+6*1 cases can be divided into 12
# "triple or all-threeness" cases which we style "rolling virtual doubles",
# and 12 "no triple, no multiples of three" cases which we treat as
# "rolling a mixed pair: 3 and 6, or vice-versa".
sub td5
{
my($a, $b, $c, $d1) = @_;
my($d2, $t);
$td_extra_actions = " ";
if ($d1 % 3 == 0) {
# We are in the troublesome threes columns. These columns contain the
# six singleton three-of-a-kind rolls, and also happen to include all
# the rolls that do not have a single "equal or adjacent" pair (the cases
# where all the dice are adjacent, or where no two are adjacent).
#
# In most cases we can fix it by replacing a single 3 or 6 by 1. But first
# we must check for the extra-special cases that can't be fixed that way.
if (($a % 3 == 0) && ($b % 3 == 0) && ($c % 3 == 0)) {
# All are a multiple of 3, we "rolled virtual doubles": D2 = D1.
$d2 = $d1; return "$d1 $d2";
} elsif (($a == $b) && ($b == $c)) {
# We rolled three-of-a-kind, which also counts as "virtual doubles".
$d2 = $d1; return "$d1 $d2";
} elsif (($a % 3 != 0) && ($b % 3 != 0) && ($c % 3 != 0)) {
# None are a multiple of 3: make it a virtual 3+6 or 6+3
$d2 = 9 - $d1; return "$d1 $d2";
}
# In all remaining cases, exactly one die is a 3 or 6. We'll "single out"
# the troublesome three by making it single, i.e. a 1.
elsif ($a % 3 == 0) {
# Change A to a 1
$a = $singletonchange;
} elsif ($b % 3 == 0) {
# Change B to a 1
$b = $singletonchange;
} elsif ($c % 3 == 0) {
# Change C to a 1
$c = $singletonchange;
}
# If we get here we have to shuffle A, B, and C to make sure they're
# in order.
if ($b > $a) { $t = $a; $a = $b; $b = $t; }
if ($c > $b) { $t = $b; $b = $c; $c = $t; }
if ($b > $a) { $t = $a; $a = $b; $b = $t; }
$td_extra_actions = "-> ($a $b $c)"; # Adds to output while logging
}
# 8/9 of the time (192 cases out of 216) we'll end up here. We will have
# either a pair of identical dice and one different, or we'll have a pair
# that differ by 1 (modulo 6); in either case we just ignore this pair
# and use the third die as D2. Amazingly, this works!
if ($a == $b) {
# A and B are a pair: C is the Lonely Die
$d2 = $c;
} elsif ($b == $c) {
# B and C are a pair: A is the Lonely Die
$d2 = $a;
} elsif ($a == $c) {
# A and C are a pair: B is the Lonely Die
$d2 = $b;
# Remaining cases are when all three dice are different. Note that they
# have been sorted A-B-C in decreasing order, so if we have the case of
# an adjacent 1 and 6, the 6 will be A and the 1 will be C.
} elsif ($a-1 == $b) {
# A adjacent to B: C is the Lonely Die
$d2 = $c;
} elsif ($b-1 == $c) {
# B adjacent to C: A is the Lonely Die
$d2 = $a;
} elsif ($a-5 == $c) {
# B adjacent to C: A is the Lonely Die
$d2 = $b;
}
return "$d1 $d2";
} # End of subroutine "td5".
# ---------------------------- Main loop starts here --------------------------
my($i, $j, $k); # The three dice that we roll (ordered)
my($a, $b, $c); # The same three dice, sorted to remove any pretense of knowing
# what order they were rolled in
my($t); # Temp used for swapping dice during the sort
my($d1); # The first virtual die, found by modulo sum (casting out 6's)
my($twodice); # A string like "3 2" representing what two virtual dice
# the algorithm decides we've rolled
my(%population);# Hash to count how many times we roll each virtual tuple
# I, J, and K are the three dice, which have 216 combinations.
print " (I J K) -> (A B C) D1 Rule 4 Result\n";
for($i=1; $i<=6; $i++) {
for($j=1; $j<=6; $j++) {
for($k=1; $k<=6; $k++) {
# In order to make sure we're solving the puzzle, we must now set three
# variables A, B, and C to be the three values we rolled, and then *sort*
# them so it's no longer possible to tell which was rolled first.
$a = $i; $b = $j; $c = $k;
# Cheapo bubble-sort
if ($b > $a) { $t = $a; $a = $b; $b = $t; }
if ($c > $b) { $t = $b; $b = $c; $c = $t; }
if ($b > $a) { $t = $a; $a = $b; $b = $t; }
# Now $a is the higest of the three die values, and $c is the lowest
# (or might be the same as $a if we happened to have rolled 3-of-a-kind)
# The first "virtual die" is easy to get: Just add the dice together,
# and subtract 6 however many times it takes to get a number from 1 to 6.
$d1 = $a+$b+$c;
if ($d1 > 6) { $d1 -= 6; }
if ($d1 > 6) { $d1 -= 6; }
# Now we use our fancy algorithm to get the second virtual die, D2,
# based on A, B, C, and our first die D1.
$twodice = &td5($a, $b, $c, $d1);
print "Rolled ($i $j $k) -> ($a $b $c) $d1 $td_extra_actions -> $twodice\n";
$population{$twodice} += 1;
}
}
}
# Now, if everything worked out all right, the hash %population should
# contain a count of exactly for every one of 36 different tuples of
# dice. For example, $population{"1 2"} should be 6 to indicate that
# we rolled the tuple (1,2) exactly 6 times.
my($tentative_success) = 1; # Let's be optimistic and assume we did it.
my($failtup); # But if we fail, this will record a point of failure.
foreach $k (sort (keys %population)) {
print "I rolled the virtual dice values: ($k) a total of $population{$k} times\n";
if ($tentative_success) {
if ($population{$k} != 6) {
print " Oh dear, this algorithm doesn't work as Lucas requested.\n";
$tentative_success = 0; $failtup = $k;
}
}
}
if ($tentative_success) {
print q`
Success!
This algorithm, albeit complex, manages to emulate two sequential
d6 rolls using only the results of three simultaneous d6 rolls.
`;
} else {
print qq`
FAIL
At least one tuple ($failtup) was not rolled 6 times.
`;
}
exit(0);
# ------------------------------------------------------------------------------
my $unused_failed_algos = q`
# Following are all the things I tried as I looked for a solution to Lucas' problem.
# Take the difference between A and B, and subtract the difference
# between B and C, and why not add that to D1 for good measure.
# all modulo 6. Fails because the signs change if you permute A,B,C.
sub td1
{
my($a, $b, $c, $d1) = @_;
my($d2);
$td_extra_actions = ""; # We don't need this
$d2 = ( $d1+ $a + 1 - ($b + 1 - $c) ) % 6;
if ($d2 == 0) { $d2 = 6; }
return "$d1 $d2";
}
# Pick one of the three dice, then pick one of the remaining two. There
# are six ways to do this, so use D1 to choose which, then discard D1.
# Inspired and seemingly symmetrical but fails because diversity is lost.
sub td2
{
my($a, $b, $c, $d1) = @_;
my($td);
$td_extra_actions = ""; # We don't need this
if ($d1 == 1) {
$td = "$a $b";
} elsif ($d1 == 2) {
$td = "$a $c";
} elsif ($d1 == 3) {
$td = "$b $a";
} elsif ($d1 == 4) {
$td = "$b $c";
} elsif ($d1 == 5) {
$td = "$c $a";
} else {
$td = "$c $b";
}
return $td;
}
# Measure how far the triple (A,B,C) is from lying on the main diagonal
# of 3-dimensional dicespace. Perfectly symmetrical, but failed because
# the distribution doesn't work out.
sub td3
{
my($a, $b, $c, $d1) = @_;
my($sum, $td, $d2);
$td_extra_actions = ""; # We don't need this
if ($d1 == 6) { print "$d1 $a $b $c"; }
$sum = $a+$b+$c;
$a = 3*$a; $b = 3*$b; $c = 3*$c;
$a=$sum-$a; $b=$sum-$b; $c=$sum-$c;
if ($a<0) { $a=0-$a; }
if ($b<0) { $b=0-$b; }
if ($c<0) { $c=0-$c; }
if ($d1 == 6) { print " -> $a $b $c"; }
$d2 = (($a+$b+$c)/2) % 6;
if ($d2 == 0) { $d2 = 6; }
if ($d1 == 6) { print " -> $d2\n"; }
$td = "$d1 $d2";
return $td;
}
# td1 didn't work, but what if we try adding coefficients to our
# linear-combination formula? Yehhhh..... Nope.
sub td4
{
my($a, $b, $c, $d1) = @_;
my($d2);
$td_extra_actions = ""; # We don't need this
$d2 = ( 3*($a + 1 - $b) + 1*($b + 1 - $c) ) % 6;
if ($d2 == 0) { $d2 = 6; }
return "$d1 $d2";
}
`;