Seven-sided dice from five-sided dice: Difference between revisions

From Rosetta Code
Content added Content deleted
(Added PicoLisp)
Line 428: Line 428:
aux
aux
;;</lang>
;;</lang>
=={{header|Perl 6}}==
=={{works with|Rakudo Star|2010.08}}==
<p>
Since rakudo is still pretty slow, we've done some interesting bits of optimization.
We factor out the range object construction so that it doesn't have to be recreated each time, and we sneakily <em>subtract</em> the 1's from the 5's, which takes us back to 0 based without having to subtract 6.
<lang perl6>my $d5 = 1..5;
sub d5() { $d5.pick; }

sub d7() {
my $flat = 21;
$flat = 5 * d5() - d5() until $flat < 21;
$flat % 7 + 1;
}</lang>
Here's the test. We use a C-style for loop, except it's named <code>loop</code>, because it's currently faster than the other loops--and, er, doesn't segfault the GC on a million iterations...
<lang perl6>my @dist;
my $n = 1_000_000;
my $expect = $n / 7;

loop ($_ = $n; $n; --$n) { @dist[d7()]++; }

say "Expect\t",$expect.fmt("%.3f");
for @dist.kv -> $i, $v {
say "$i\t$v\t" ~ (($v - $expect)/$expect*100).fmt("%+.2f%%") if $v;
}</lang>
And the output:
<lang>Expect 142857.143
1 142835 -0.02%
2 143021 +0.11%
3 142771 -0.06%
4 142706 -0.11%
5 143258 +0.28%
6 142485 -0.26%
7 142924 +0.05%</lang>


=={{header|PicoLisp}}==
=={{header|PicoLisp}}==

Revision as of 05:47, 28 August 2010

Task
Seven-sided dice from five-sided dice
You are encouraged to solve this task according to the task description, using any language you may know.

Given an equal-probability generator of one of the integers 1 to 5 as dice5; create dice7 that generates a pseudo-random integer from 1 to 7 in equal probability using only dice5 as a source of random numbers, and check the distribution for at least 1000000 calls using the function created in Simple Random Distribution Checker.

dice7 might call dice5 twice, re-call if four of the 25 combinations are given, otherwise split the other 21 combinations into 7 groups of three, and return the group index from the rolls.

(Task adapted from an answer here)

ALGOL 68

Translation of: C

- note: This specimen retains the original C coding style.

Works with: ALGOL 68 version Revision 1 - no extensions to language used
Works with: ALGOL 68G version Any - tested with release 1.18.0-9h.tiny
Works with: ELLA ALGOL 68 version Any (with appropriate job cards) - tested with release 1.8-8d

C's version using no multiplications, divisions, or mod operators: <lang algol68>PROC dice5 = INT:

 1 + ENTIER (5*random);

PROC mulby5 = (INT n)INT:

  ABS (BIN n SHL 2) + n;

PROC dice7 = INT: (

 INT d55 := 0;
 INT m := 1;
 WHILE
   m := ABS ((2r1 AND BIN m) SHL 2) + ABS (BIN m SHR 1);  # repeats 4 - 2 - 1 #
   d55 := mulby5(mulby5(d55)) + mulby5(dice5) + dice5 - 6;
  1. WHILE # d55 < m DO SKIP OD;
 m := 1;
 WHILE d55>0 DO
   d55 +:= m;
   m := ABS (BIN d55 AND 2r111); # modulas by 8 #
   d55 := ABS (BIN d55 SHR 3)    # divide by 8 #
 OD;
 m

);

PROC distcheck = (PROC INT dice, INT count, upb)VOID: (

 [upb]INT sum; FOR i TO UPB sum DO sum[i] := 0 OD;
 FOR i TO count DO sum[dice]+:=1 OD;
 FOR i TO UPB sum WHILE print(whole(sum[i],0)); i /= UPB sum DO print(", ") OD;
 print(new line)

);

main: (

 distcheck(dice5, 1000000, 5);
 distcheck(dice7, 1000000, 7)

)</lang> Sample output:

200598, 199852, 199939, 200602, 199009
143529, 142688, 142816, 142747, 142958, 142802, 142460

AutoHotkey

<lang AutoHotkey>dice5() { Random, v, 1, 5

  Return, v

}

dice7() { Loop

  {  v := 5 * dice5() + dice5() - 6
     IfLess v, 21, Return, (v // 3) + 1
  }

}</lang>

Distribution check:

Total elements = 10000

Margin = 3% --> Lbound = 1386, Ubound = 1471

Bucket 1 contains 1450 elements.
Bucket 2 contains 1374 elements. Skewed.
Bucket 3 contains 1412 elements.
Bucket 4 contains 1465 elements.
Bucket 5 contains 1370 elements. Skewed.
Bucket 6 contains 1485 elements. Skewed.
Bucket 7 contains 1444 elements.

C

A version using no multiplications, divisions, or mod operators. <lang c>#include <stdio.h>

  1. include <stdlib.h>
  2. include <math.h>

void distcheck(int (*)(), int, double);

int dice5() {

 return 1 + (int)(5.0*rand() / (RAND_MAX + 1.0));

} int mulby5(n) {

  return (n<<2) + n;

}

int dice7() {

 int d55 = 0;
 int m = 1;
 do {
   m = ((1&m)<<2) + (m>>1);  // repeats 4 - 2 - 1
   d55 = mulby5(mulby5(d55)) + mulby5(dice5()) + dice5() - 6;
 } while (d55 < m);
 m = 1;
 while (d55>0) {
   d55 += m;
   m = d55 & 7;
   d55 >>= 3;
 }
 return m;

}

int main() {

 distcheck(dice5, 1000000, 1);
 distcheck(dice7, 1000000, 1);
 return 0;

}</lang>

C++

This solution tries to minimize calls to the underlying d5 by reusing information from earlier calls.

<lang cpp>template<typename F> class fivetoseven { public:

 fivetoseven(F f): d5(f), rem(0), max(1) {}
 int operator()();

private:

 F d5;
 int rem, max;

};

template<typename F>

int fivetoseven<F>::operator()()

{

 while (rem/7 == max/7)
 {
   while (max < 7)
   {
     int rand5 = d5()-1;
     max *= 5;
     rem = 5*rem + rand5;
   }
   int groups = max / 7;
   if (rem >= 7*groups)
   {
     rem -= 7*groups;
     max -= 7*groups;
   }
 }
 int result = rem % 7;
 rem /= 7;
 max /= 7;
 return result+1;

}

int d5() {

 return 5.0*std::rand()/(RAND_MAX + 1.0) + 1;

}

fivetoseven<int(*)()> d7(d5);

int main() {

 srand(time(0));
 test_distribution(d5, 1000000, 0.001);
 test_distribution(d7, 1000000, 0.001);

}</lang>

Common Lisp

Translation of: C

<lang lisp>(defun d5 ()

 (1+ (random 5)))

(defun d7 ()

 (loop for d55 = (+ (* 5 (d5)) (d5) -6)
       until (< d55 21)
       finally (return (1+ (mod d55 7)))))</lang>
> (check-distribution 'd7 1000)
Distribution potentially skewed for 1: expected around 1000/7 got 153.
Distribution potentially skewed for 2: expected around 1000/7 got 119.
Distribution potentially skewed for 3: expected around 1000/7 got 125.
Distribution potentially skewed for 7: expected around 1000/7 got 156.
T
#<EQL Hash Table{7} 200B5A53>

> (check-distribution 'd7 10000)
NIL
#<EQL Hash Table{7} 200CB5BB>

D

Translation of: C++

<lang d>import std.random: rand; import distcheck: distCheck;

/// generates a random number in [1, 5] int dice5() {

   return 1 + cast(int)((rand() / cast(double)uint.max) * 5.0);

}


/// Naive version, generates a random number in [1, 7] using dice5 int dice7() {

   int r = dice5() + dice5() * 5 - 6;
   return (r < 21) ? (r % 7) + 1 : dice7();

}


/** Generates a random number in [1, 7] using dice5, minimizing calls to dice 5.

  • /

struct FiveToSeven(alias d5) {

   int opCall() {
       while (rem / 7 == max / 7) {
           while (max < 7) {
               int rand5 = d5() - 1;
               max *= 5;
               rem = 5 * rem + rand5;
           }
           int groups = max / 7;
           if (rem >=  7 * groups) {
               rem -= 7 * groups;
               max -= 7 * groups;
           }
       }
       int result = rem % 7;
       rem /= 7;
       max /= 7;
       return result + 1;
   }
   private:
       int rem = 0, max = 1;

}


void main() {

   const int N = 1_000_000;
   distCheck(&dice5, N, 1);
   distCheck(&dice7, N, 1); // naive version
   FiveToSeven!(dice5) dice7b;
   distCheck(&dice7b.opCall, N, 1);

}</lang>

Output:
[1:200416,2:199418,3:199471,4:200016,5:200679]
[1:142443,2:143605,3:142878,4:143038,5:142595,6:142205,7:143236]
[1:143354,2:143240,3:142882,4:142641,5:142715,6:142779,7:142389]

E

Translation of: Common Lisp


This example is in need of improvement:

Write dice7 in a prettier fashion and use the distribution checker once it's been written.

<lang e>def dice5() {

 return entropy.nextInt(5) + 1

}

def dice7() {

 var d55 := null
 while ((d55 := 5 * dice5() + dice5() - 6) >= 21) {}
 return d55 %% 7 + 1

}</lang>

<lang e>def bins := ([0] * 7).diverge() for x in 1..1000 {

 bins[dice7() - 1] += 1

} println(bins.snapshot())</lang>

Haskell

<lang haskell>import System.Random import Data.List

sevenFrom5Dice = do

 d51 <- randomRIO(1,5) :: IO Int
 d52 <- randomRIO(1,5) :: IO Int
 let d7 = 5*d51+d52-6
 if d7 > 20 then sevenFrom5Dice
      else return $ 1 + d7 `mod` 7</lang>

Output: <lang haskell>*Main> replicateM 10 sevenFrom5Dice [2,3,1,1,6,2,5,6,5,3]</lang> Test: <lang haskell>*Main> mapM_ print .sort =<< distribCheck sevenFrom5Dice 1000000 3 (1,(142759,True)) (2,(143078,True)) (3,(142706,True)) (4,(142403,True)) (5,(142896,True)) (6,(143028,True)) (7,(143130,True))</lang>

J

The first step is to create 7-sided dice rolls from 5-sided dice rolls (rollD5): <lang j>rollD5=: [: >: ] ?@$ 5: NB. makes a y shape array of 5s, "rolls" the array and increments. roll2xD5=: [: rollD5 2 ,~ */ NB. rolls D5 twice for each desired D7 roll (y rows, 2 cols) toBase10=: 5 #. <: NB. decrements and converts rows from base 5 to 10 keepGood=: #~ 21&> NB. compress out values not less than 21 groupin3s=: [: >. >: % 3: NB. increments, divides by 3 and takes ceiling

getD7=: groupin3s@keepGood@toBase10@roll2xD5</lang>

Here are a couple of variations on the theme that achieve the same result: <lang j>getD7b=: 0 8 -.~ 3 >.@%~ 5 #. [: <:@rollD5 2 ,~ ] getD7c=: [: (#~ 7&>:) 3 >.@%~ [: 5&#.&.:<:@rollD5 ] , 2:</lang>

The trouble is that we probably don't have enough D7 rolls yet because we compressed out any double D5 rolls that evaluated to 21 or more. So we need to accumulate some more D7 rolls until we have enough. J has two types of verb definition - tacit (arguments not referenced) and explicit (more conventional function definitions) illustrated below:

Here's an explicit definition that accumulates rolls from getD7: <lang j>rollD7x=: monad define

 n=. */y                             NB. product of vector y is total number of D7 rolls required
 rolls=.                           NB. initialize empty noun rolls
 while. n > #res do.                 NB. checks if if enough D7 rolls accumulated
   rolls=. rolls, getD7 >. 0.75 * n  NB. calcs 3/4 of required rolls and accumulates getD7 rolls
 end.
 y $ rolls                           NB. shape the result according to the vector y

)</lang>

Here's a tacit definition that does the same thing: <lang j>getNumRolls=: [: >. 0.75 * */@[ NB. calc approx 3/4 of the required rolls accumD7Rolls=: ] , getD7@getNumRolls NB. accumulates getD7 rolls isNotEnough=: */@[ > #@] NB. checks if enough D7 rolls accumulated

rollD7t=: ] $ (accumD7Rolls ^: isNotEnough ^:_)&</lang> The verb1 ^: verb2 ^:_ construct repeats x verb1 y while x verb2 y is true. It is like saying "Repeat accumD7Rolls while isNotEnough".

Example usage: <lang j> rollD7t 10 NB. 10 rolls of D7 6 4 5 1 4 2 4 5 2 5

  rollD7t 2 5        NB. 2 by 5 array of D7 rolls

5 1 5 1 3 3 4 3 5 6

  rollD7t 2 3 5      NB. 2 by 3 by 5 array of D7 rolls

4 7 7 5 7 3 7 1 4 5 5 4 5 7 6

1 1 7 6 3 4 4 1 4 4 1 1 1 6 5

NB. check results from rollD7x and rollD7t have same shape

  ($@rollD7x -: $@rollD7t) 10     

1

  ($@rollD7x -: $@rollD7t) 2 3 5   

1</lang>

JavaScript

Translation of: Ruby

<lang javascript>function dice5() {

   return 1 + Math.floor(5 * Math.random())

}

function dice7() {

   while (true) {
       var dice55 = 5 * dice5() + dice5() - 6
       if (dice55 < 21)
           return dice55 % 7 + 1;
   }

}

distcheck(dice5, 1000000); print(); distcheck(dice7, 1000000);</lang> output

1       199792
2       200425
3       199243
4       200407
5       200133

1       143617
2       142209
3       143023
4       142990
5       142894
6       142648
7       142619 

Lua

<lang lua>dice5 = function() return math.random(5) end

function dice7()

 x = dice5() * 5 + dice5() - 6
 if x > 20 then return dice7() end
 return x%7 + 1

end</lang>

OCaml

<lang ocaml>let dice5() = 1 + Random.int 5 ;;

let dice7 =

 let rolls2answer = Hashtbl.create 25 in
 let n = ref 0 in
 for roll1 = 1 to 5 do
   for roll2 = 1 to 5 do
     Hashtbl.add rolls2answer (roll1,roll2) (!n / 3 +1);
     incr n
   done;
 done;
 let rec aux() =
   let trial = Hashtbl.find rolls2answer (dice5(),dice5()) in
   if trial <= 7 then trial else aux()
 in
 aux
</lang>

Perl 6

Works with: Rakudo Star version 2010.08

Since rakudo is still pretty slow, we've done some interesting bits of optimization. We factor out the range object construction so that it doesn't have to be recreated each time, and we sneakily subtract the 1's from the 5's, which takes us back to 0 based without having to subtract 6. <lang perl6>my $d5 = 1..5; sub d5() { $d5.pick; } sub d7() { my $flat = 21; $flat = 5 * d5() - d5() until $flat < 21; $flat % 7 + 1; }</lang> Here's the test. We use a C-style for loop, except it's named loop, because it's currently faster than the other loops--and, er, doesn't segfault the GC on a million iterations... <lang perl6>my @dist; my $n = 1_000_000; my $expect = $n / 7; loop ($_ = $n; $n; --$n) { @dist[d7()]++; } say "Expect\t",$expect.fmt("%.3f"); for @dist.kv -> $i, $v { say "$i\t$v\t" ~ (($v - $expect)/$expect*100).fmt("%+.2f%%") if $v; }</lang> And the output: <lang>Expect 142857.143 1 142835 -0.02% 2 143021 +0.11% 3 142771 -0.06% 4 142706 -0.11% 5 143258 +0.28% 6 142485 -0.26% 7 142924 +0.05%</lang>

PicoLisp

<lang PicoLisp>(de dice5 ()

  (rand 1 5) )

(de dice7 ()

  (use R
     (until (> 21 (setq R (+ (* 5 (dice5)) (dice5) -6))))
     (inc (% R 7)) ) )</lang>

Output:

: (let R NIL
   (do 1000000 (accu 'R (dice7) 1))
   (sort R) )
-> ((1 . 142295) (2 . 142491) (3 . 143448) (4 . 143129) (5 . 142701) (6 . 143142) (7 . 142794))

PureBasic

Translation of: Lua

<lang PureBasic>Procedure dice5()

 ProcedureReturn Random(4) + 1

EndProcedure

Procedure dice7()

 Protected x
 
 x = dice5() * 5 + dice5() - 6
 If x > 20 
   ProcedureReturn dice7()
 EndIf 
 
 ProcedureReturn x % 7 + 1

EndProcedure</lang>

Python

<lang python>from random import randint

def dice5():

   return randint(1, 5)

def dice7():

   r = dice5() + dice5() * 5 - 6
   return (r % 7) + 1 if r < 21 else dice7()</lang>

Distribution check using Simple Random Distribution Checker:

>>> distcheck(dice5, 1000000, 1)
{1: 200244, 2: 199831, 3: 199548, 4: 199853, 5: 200524}
>>> distcheck(dice7, 1000000, 1)
{1: 142853, 2: 142576, 3: 143067, 4: 142149, 5: 143189, 6: 143285, 7: 142881}

R

5-sided die. <lang r>dice5 <- function(n=1) sample(5, n, replace=TRUE)</lang> Simple but slow 7-sided die, using a while loop. <lang r>dice7.while <- function(n=1) {

  score <- numeric()
  while(length(score) < n)
  {
     total <- sum(c(5,1) * dice5(2)) - 3
     if(total < 24) score <- c(score, total %/% 3)
  } 
  score 

} system.time(dice7.while(1e6)) # longer than 4 minutes</lang> More complex, but much faster vectorised version. <lang r>dice7.vec <- function(n=1, checkLength=TRUE) {

  morethan2n <- 3 * n + 10 + (n %% 2)       #need more than 2*n samples, because some are discarded
  twoDfive <- matrix(dice5(morethan2n), nrow=2)
  total <- colSums(c(5, 1) * twoDfive) - 3
  score <- ifelse(total < 24, total %/% 3, NA)
  score <- score[!is.na(score)]
  #If length is less than n (very unlikely), add some more samples
  if(checkLength) 
  {
     while(length(score) < n)
     {
        score <- c(score, dice7(n, FALSE)) 
     }
     score[1:n]
  } else score  

} system.time(dice7.vec(1e6)) # ~1 sec</lang>

Ruby

Translation of: Tcl

Uses distcheck from here. <lang ruby>require './distcheck.rb'

def d5

 1 + rand(5)

end

def d7

 loop do
   d55 = 5*d5() + d5() - 6
   return (d55 % 7 + 1) if d55 < 21
 end

end

distcheck(1_000_000) {d5} distcheck(1_000_000) {d7}</lang>

output

1 200478 2 199986 3 199582 4 199560 5 200394 
1 142371 2 142577 3 143328 4 143630 5 142553 6 142692 7 142849 

Tcl

Any old D&D hand will know these as a D5 and a D7... <lang tcl>proc D5 {} {expr {1 + int(5 * rand())}}

proc D7 {} {

   while 1 {
       set d55 [expr {5 * [D5] + [D5] - 6}]
       if {$d55 < 21} {
           return [expr {$d55 % 7 + 1}]
       }
   }

}</lang> Checking:

% distcheck D5 1000000
1 199893 2 200162 3 200075 4 199630 5 200240
% distcheck D7 1000000
1 143121 2 142383 3 143353 4 142811 5 142172 6 143291 7 142869

VBScript

This example is in need of improvement:

Use the distribution checker once it's been written.

<lang vb>option explicit

dim rolls rolls = "11,12,13,14,15,21,22,23,24,25,31,32,33,34,35,41,42,43,44,45,51,"

randomize timer

function irandom(n) irandom = int(rnd*n)+1 end function

function d7() dim j do j = instr( rolls, irandom(5) & irandom(5) ) if j <> 0 then d7 = (((j-1)/3) mod 7)+1 exit function end if loop end function</lang>