Re: Loaded die

Cache the partial results:

use 5.010;

use strict;
use warnings;

use List::Util 'sum';

my @props = (0.05, 0.1, 0.2, 0.3);
push @props, 1 - sum @props;     # Make sure we sum to 1.

my @THROWS = (5, 10, 25);
my @values = (1, 5, 7, 13, 17, 23, 31, 43, 59, 91, 119);

my %cache;
sub chance;
sub chance {
    my $throws = shift;
    my $target = shift;

    return $cache{$throws, $target} if defined $cache{$throws, $target
+};

    return $cache{$throws, $target} = 0 if $throws < 1 || $target < $t
+hrows;
    if ($throws == 1) {
        return $cache{$throws, $target} = 0 if $target > @props;
        return $cache{$throws, $target} = $props[$target-1];  
    }
    return $cache{$throws, $target} =
            sum map {$props[$_-1] * chance $throws-1, $target-$_} 1 ..
+ $#props;      
}

my $start = sum times;

foreach my $throws (@THROWS) {
    foreach my $value (@values) {
        say "Chance of hitting $value in $throws throws: ", chance $th
+rows, $value;
    }
} 

my $end = sum times;
say "Running time: ", 1000 * ($end - $start), " milli-seconds";

__END__
Chance of rolling 1 in 5 throws: 0
Chance of rolling 5 in 5 throws: 3.125e-07
Chance of rolling 7 in 5 throws: 1.875e-05
Chance of rolling 13 in 5 throws: 0.00968
Chance of rolling 17 in 5 throws: 0.031295
Chance of rolling 23 in 5 throws: 0
Chance of rolling 31 in 5 throws: 0
Chance of rolling 43 in 5 throws: 0
Chance of rolling 59 in 5 throws: 0
Chance of rolling 91 in 5 throws: 0
Chance of rolling 119 in 5 throws: 0
Chance of rolling 1 in 10 throws: 0
Chance of rolling 5 in 10 throws: 0
Chance of rolling 7 in 10 throws: 0
Chance of rolling 13 in 10 throws: 1.69921875e-10
Chance of rolling 17 in 10 throws: 1.014837890625e-07
Chance of rolling 23 in 10 throws: 5.2156428125e-05
Chance of rolling 31 in 10 throws: 0.00234761235
Chance of rolling 43 in 10 throws: 0
Chance of rolling 59 in 10 throws: 0
Chance of rolling 91 in 10 throws: 0
Chance of rolling 119 in 10 throws: 0
Chance of rolling 1 in 25 throws: 0
Chance of rolling 5 in 25 throws: 0
Chance of rolling 7 in 25 throws: 0
Chance of rolling 13 in 25 throws: 0
Chance of rolling 17 in 25 throws: 0
Chance of rolling 23 in 25 throws: 0
Chance of rolling 31 in 25 throws: 1.08633041381835938e-25
Chance of rolling 43 in 25 throws: 7.92373889330642701e-17
Chance of rolling 59 in 25 throws: 9.08413811215993471e-10
Chance of rolling 91 in 25 throws: 1.16278186292830531e-07
Chance of rolling 119 in 25 throws: 0
Running time: 90 milli-seconds
[download]

I don't have an explaination why the chance of rolling 119 in 25 throws is 0 - it calculates any roll above 101 for 25 throws to be 0.

Comment on Re: Loaded die Download Code

Replies are listed 'Best First'.
Re^2: Loaded die by Microcebus (Beadle) on Mar 28, 2011 at 13:50 UTC
I think this code does not exactly what I need. I want to calculate the propability to roll x OR MORE. And @values shall contain the pips on each side of the die (so number of elements equals number of sides of the die) rather than the summed pips I want to reach.	[reply]
Re^3: Loaded die by JavaFan (Canon) on Mar 28, 2011 at 14:54 UTC
What stopped you from adapting the program I posted? Anyway: #!/usr/bin/perl use 5.010; use strict; use warnings; use List::Util 'sum'; my @dice = ([1 => 0.05], [5 => 0.1], [7 => 0.2], [13 => 0.3], [17 => + 0.35]); my %dice = map {$$_[0], $$_[1]} @dice; my $THROWS = 5; my %cache; sub chance; sub chance { my $throws = shift; my $target = shift; return $cache{$throws, $target} if defined $cache{$throws, $target +}; return $cache{$throws, $target} = 0 if $throws < 1 \|\| $target < $t +hrows * $dice[0][0] \|\| $target > $t +hrows * $dice[-1][0]; return $cache{$throws, $target} = $dice{$target} \|\| 0 if $throws = += 1; return $cache{$throws, $target} = sum map {$dice{$_} * chance $throws-1, $target-$_} keys %d +ice; } my $start = sum times; my %total; my $MIN = $THROWS * $dice[0][0]; my $MAX = $THROWS * $dice[-1][0] + 1; foreach my $value ($MIN .. $MAX) { my $chance = chance $THROWS, $value; foreach my $value ($MIN .. $value) { $total{$value} += $chance; } } foreach my $value ($MIN .. $MAX) { say "Chance of rolling $value or higher: $total{$value}"; } my $end = sum times; say "Running time: ", 1000 * ($end - $start), " milli-seconds"; __END__ Chance of rolling 5 or higher: 1 Chance of rolling 6 or higher: 0.9999996875 Chance of rolling 7 or higher: 0.9999996875 Chance of rolling 8 or higher: 0.9999996875 Chance of rolling 9 or higher: 0.9999996875 Chance of rolling 10 or higher: 0.9999965625 Chance of rolling 11 or higher: 0.9999965625 Chance of rolling 12 or higher: 0.9999903125 Chance of rolling 13 or higher: 0.9999903125 Chance of rolling 14 or higher: 0.9999778125 Chance of rolling 15 or higher: 0.9999778125 Chance of rolling 16 or higher: 0.9999278125 Chance of rolling 17 or higher: 0.9999278125 Chance of rolling 18 or higher: 0.9998434375 Chance of rolling 19 or higher: 0.9998434375 Chance of rolling 20 or higher: 0.9996934375 Chance of rolling 21 or higher: 0.9996934375 Chance of rolling 22 or higher: 0.9992825 Chance of rolling 23 or higher: 0.9992825 Chance of rolling 24 or higher: 0.9987325 Chance of rolling 25 or higher: 0.9987325 Chance of rolling 26 or higher: 0.99781 Chance of rolling 27 or higher: 0.99781 Chance of rolling 28 or higher: 0.995835 Chance of rolling 29 or higher: 0.995835 Chance of rolling 30 or higher: 0.99346 Chance of rolling 31 or higher: 0.99346 Chance of rolling 32 or higher: 0.98981 Chance of rolling 33 or higher: 0.98981 Chance of rolling 34 or higher: 0.9829225 Chance of rolling 35 or higher: 0.9829225 Chance of rolling 36 or higher: 0.9755525 Chance of rolling 37 or higher: 0.9755525 Chance of rolling 38 or higher: 0.964499375 Chance of rolling 39 or higher: 0.964499375 Chance of rolling 40 or higher: 0.946949375 Chance of rolling 41 or higher: 0.946949375 Chance of rolling 42 or higher: 0.929305625 Chance of rolling 43 or higher: 0.929305625 Chance of rolling 44 or higher: 0.903868125 Chance of rolling 45 or higher: 0.903868125 Chance of rolling 46 or higher: 0.868668125 Chance of rolling 47 or higher: 0.868668125 Chance of rolling 48 or higher: 0.836118125 Chance of rolling 49 or higher: 0.836118125 Chance of rolling 50 or higher: 0.787436875 Chance of rolling 51 or higher: 0.787436875 Chance of rolling 52 or higher: 0.733586875 Chance of rolling 53 or higher: 0.733586875 Chance of rolling 54 or higher: 0.684515 Chance of rolling 55 or higher: 0.684515 Chance of rolling 56 or higher: 0.614865 Chance of rolling 57 or higher: 0.614865 Chance of rolling 58 or higher: 0.5482525 Chance of rolling 59 or higher: 0.5482525 Chance of rolling 60 or higher: 0.4874775 Chance of rolling 61 or higher: 0.4874775 Chance of rolling 62 or higher: 0.4036525 Chance of rolling 63 or higher: 0.4036525 Chance of rolling 64 or higher: 0.3487025 Chance of rolling 65 or higher: 0.3487025 Chance of rolling 66 or higher: 0.283185 Chance of rolling 67 or higher: 0.283185 Chance of rolling 68 or higher: 0.217035 Chance of rolling 69 or higher: 0.217035 Chance of rolling 70 or higher: 0.1733834375 Chance of rolling 71 or higher: 0.1733834375 Chance of rolling 72 or higher: 0.1219334375 Chance of rolling 73 or higher: 0.1219334375 Chance of rolling 74 or higher: 0.0813553125 Chance of rolling 75 or higher: 0.0813553125 Chance of rolling 76 or higher: 0.0663490625 Chance of rolling 77 or higher: 0.0663490625 Chance of rolling 78 or higher: 0.0277615625 Chance of rolling 79 or higher: 0.0277615625 Chance of rolling 80 or higher: 0.0277615625 Chance of rolling 81 or higher: 0.0277615625 Chance of rolling 82 or higher: 0.0052521875 Chance of rolling 83 or higher: 0.0052521875 Chance of rolling 84 or higher: 0.0052521875 Chance of rolling 85 or higher: 0.0052521875 Chance of rolling 86 or higher: 0 Running time: 20 milli-seconds [download]	[reply] [d/l]
Re^3: Loaded die by roboticus (Chancellor) on Mar 28, 2011 at 14:51 UTC
Microcebus: If you want to approach it analytically: #!/usr/bin/perl use strict; use warnings; use Data::Dumper; my $num_dice = 5; my @probabilities = ( 0.05, 0.10, 0.20, 0.30, 0.35 ); my @values = ( 1, 5, 7, 13, 17 ); my $throw_die_ntimes = 5; my @possibilities = (); my $it = combo($num_dice, 0 .. $num_dice-1); while (my $t = &$it()) { $possibilities[ttl($t)] += prob($t); } my $cum=0; for my $ttl (0 .. $#possibilities) { next if ! defined $possibilities[$ttl]; $cum += $possibilities[$ttl]; printf "% 5u prob=%.8f, prob<=:%.8f, prob>:%.8f\n", $ttl, $possibilities[$ttl], $cum, 1-$cum; } sub prob { my $prob=1; $prob = $probabilities[$_] for @{$_[0]}; return $prob; } sub ttl { my $total=0; $total += $values[$_] for @{$_[0]}; return $total; } sub combo { my ($num_dice, @list) = @_; my @position = ($#list) x $num_dice; my $done_fl = 0; # Since we pre-decrement, adjust so we return proper item on first + pass $position[0]++; return sub { return undef if $done_fl; my $cur = 0; { if (--$position[$cur] < 0) { # reset current dig & try next one $position[$cur] = $#list; $cur++; if ($cur > $num_dice) { $done_fl=1; return undef; } redo; } } return [ @list[@position] ]; } } [download] When run, I get: $ perl 895892.pl 5 prob=0.00000031, prob<=:0.00000031, prob>:0.99999969 9 prob=0.00000313, prob<=:0.00000344, prob>:0.99999656 11 prob=0.00000625, prob<=:0.00000969, prob>:0.99999031 13 prob=0.00001250, prob<=:0.00002219, prob>:0.99997781 15 prob=0.00005000, prob<=:0.00007219, prob>:0.99992781 17 prob=0.00008438, prob<=:0.00015656, prob>:0.99984344 19 prob=0.00015000, prob<=:0.00030656, prob>:0.99969344 21 prob=0.00041094, prob<=:0.00071750, prob>:0.99928250 23 prob=0.00055000, prob<=:0.00126750, prob>:0.99873250 25 prob=0.00092250, prob<=:0.00219000, prob>:0.99781000 27 prob=0.00197500, prob<=:0.00416500, prob>:0.99583500 29 prob=0.00237500, prob<=:0.00654000, prob>:0.99346000 31 prob=0.00365000, prob<=:0.01019000, prob>:0.98981000 33 prob=0.00688750, prob<=:0.01707750, prob>:0.98292250 35 prob=0.00737000, prob<=:0.02444750, prob>:0.97555250 37 prob=0.01105313, prob<=:0.03550063, prob>:0.96449937 39 prob=0.01755000, prob<=:0.05305063, prob>:0.94694937 41 prob=0.01764375, prob<=:0.07069438, prob>:0.92930562 43 prob=0.02543750, prob<=:0.09613188, prob>:0.90386812 45 prob=0.03520000, prob<=:0.13133188, prob>:0.86866812 47 prob=0.03255000, prob<=:0.16388187, prob>:0.83611813 49 prob=0.04868125, prob<=:0.21256312, prob>:0.78743688 51 prob=0.05385000, prob<=:0.26641312, prob>:0.73358688 53 prob=0.04907188, prob<=:0.31548500, prob>:0.68451500 55 prob=0.06965000, prob<=:0.38513500, prob>:0.61486500 57 prob=0.06661250, prob<=:0.45174750, prob>:0.54825250 59 prob=0.06077500, prob<=:0.51252250, prob>:0.48747750 61 prob=0.08382500, prob<=:0.59634750, prob>:0.40365250 63 prob=0.05495000, prob<=:0.65129750, prob>:0.34870250 65 prob=0.06551750, prob<=:0.71681500, prob>:0.28318500 67 prob=0.06615000, prob<=:0.78296500, prob>:0.21703500 69 prob=0.04365156, prob<=:0.82661656, prob>:0.17338344 71 prob=0.05145000, prob<=:0.87806656, prob>:0.12193344 73 prob=0.04057812, prob<=:0.91864469, prob>:0.08135531 75 prob=0.01500625, prob<=:0.93365094, prob>:0.06634906 77 prob=0.03858750, prob<=:0.97223844, prob>:0.02776156 81 prob=0.02250937, prob<=:0.99474781, prob>:0.00525219 85 prob=0.00525219, prob<=:1.00000000, prob>:0.00000000 [download] ...roboticus When your only tool is a hammer, all problems look like your thumb.*	[reply] [d/l] [select]


Just another Perl shrine
	PerlMonks