If you don't want to think too hard, you can find the expected value experimentally -- Just do a million (or so) status rolls see what the average is. Note the array-slice of the sort, which finds the 3 highest dice with much less mucky-muck.

use List::Util 'sum';

my ($iter, $sum) = shift || 1_000_000;

$sum += sum +(sort map {1 + int rand 6} 1..4)[1..3] for 1..$iter;

print $sum/$iter, $/;
[download]

You could also use some of the Die/Dice modules on CPAN, but rolling (fair) dice is pretty trivial to do yourself.

See, I was going to use sort to get the highest three values, but sort slaps together repeated values, so that sort(1,3,3,7) gives (1,3,7). Is there some way around this? I think there's a pragma to make sort use a stable method (which would have the side effect of not deleting dupes?), but it's in 5.8, and I'm using 5.6 here. (Old, old distribution which desperately needs an upgrade.)

Huh?

$ perl -e 'print join " ", sort 1,1,1,3,3,7'
1 1 1 3 3 7
[download]

Unstable sorting means input order isn't preserved for ties, not that stuff is removed. By your reasoning, sort { 0 } @array would just return one element every time, since all the items are tied in sorting order.

blokhead

Back on subject, yes, seriously this time. This is just a coincidence. Example to illustrate a point: It's sort of possible that a lottery number could be 1111111111111111, and that's no more likely than it being any other number. Yet if it was all 1's, someone not well versed in Probability might cry foul. If we used something other than base 10, you wouldn't even notice you had a strange average die roll :)

Really, I'd like to see you prove that number through statistics versus the Monte Carlo or Brute Force method. Much more interesting. Of course, being a lazy programmer with a lot of powerful hardware in front of me (who has pretty much forgetten all of his College Stat class), I'd go for the Monte Carlo or Brute Force method myself :)

Everyone knows that ADnD dice are from a different universe and don't follow the law of probability. I, for instance, own a set of dice that just know when to waste the high rolls, and that roll low when you really don't want a low roll.

I've had one character that probably has inflicted more damage to party members than to opponents (and not on purpose - my current character on the other hand....). Like the time my dwarf was 20 yards away from a fight between the thief in our party and a nearly dead nasty. So, the dwarf decides to shoot a cross-bolt. Right.... The attack roll (on a d20) was 1, fumble. Roll again, another 1. So I hit the thief. Roll again, this time a 20, so it's going to be a critical hit. Roll for damage: a 10 on a d10. Poor thief, she hadn't lost a single hp in the fight so far, but now she was on death's door step, with an arrow between her shoulder blades.

But when I fight a lonely kobold, with 1 hp left and no armour, it's garanteed I'll roll a 20.

Abigail

Everyone knows that ADnD dice are from a different universe and don't follow the law of probability.

I'd like to add other experimental evidences: for example, a d100 will tend to give < 5 values during a Rolemaster session, and > 95 values during a Call of Cthulhu session. The same dice. My understanding is that dice know what game you're playing, and its basic rules. They don't merely refuse to follow probability, they follow their evil plans against players :)

perl -MMath::BigFloat -le 'print scalar Math::BigFloat->new(15869)->br
+ound(100)->bdiv(1296)'

12.2445987654320987654320987654320987654320987654320987654320987654320
+9876543209876543209876543209877
[download]

I actually used a Monte Carlo method as a first try, before enumerating all possibilities. I made the mistake of making it way too general, but it does in fact make the rolls.

#!/usr/bin/perl -w

use strict;
srand;

my $iters = $ARGV[0] ? $ARGV[0] : 10;
my $sum = 0;

my $numdice = 4;
my $sides = 6;

sub dice ($$) {
        my ($num,$sides) = @_;
        my @ret = ();
        my $min = $sides;
        for (1..$num) {
                my $roll = int(($sides)*rand)+1;
                $min = $roll < $min ? $roll : $min;
                push @ret, $roll;
        }
#       print "rolled [@ret]; min $min\n";
        my $sum = 0;
        foreach (@ret) { $sum += $_ }
        return $sum - $min;
}

for (1..$iters) {
        $sum += dice($numdice,$sides);
} # main loop

print "average over $iters rolls is ".($sum/$iters)."\n";
[download]

Yeah; that's just kinda pasted in from the quick-n-dirty scratchbox. It gives the right result, which was what I was interested in at the time. Someday my code will start to look nicer, but this will require time. Time, and friends asking me to do weird tasks using Perl.

I wanted a precise answer, and the friend who asked me to do the computation asked me why I didn't just enumerate all 6**4 possible 4d6 rolls, and go from there. So I did.

This is just a coincidence

Actually, it's not coincidence. Any fraction when converted to a decimal will become either a finite length or recurring decimal number. For example, 80/81 is 0.98765432098765432098765432... etc.

I suspect that if you calculated the expected value the analytical way, you would end up with a fraction that was somehow related to 80/81.

C.

Though the node title implies otherwise, it would appear that the OP isn't generating random die rolls, but calculating the average die roll from 4d6 drop the lowest.

It probably sounds like a silly sort of thing, but as a gamemaster, I have actually found myself working out what the average roll for a given group of dice is, and what the percentage chance of any given number from a given group of dice, for the purpose of crafting a random roll chart.

And here's my simplified version, I decided to stick with the nested for loops so as to stay with the methodology of the OP's code, also, instead of counting iterations, I just did 6**4, since the number of iterations won't change.

#!/usr/bin/perl
use warnings;
use strict;
my $total;
for my $i (1..6) {
for my $j (1..6) {
for my $k (1..6) {
for my $l (1..6) {
    # get the sum for this dice-roll
    my @roll = (sort ($i, $j, $k, $l))[1..3];
    $total += eval join '+', @roll ;
}}}}
print $total/6**4
[download]

or, if you'd prefer, as a (somewhat unwieldy) one-liner:

for $i(1..6){for $j(1..6){for $k(1..6){for $l(1..6){$total+=eval join '+',(sort($i,$j,$k,$l))[1..3]}}}}print $total/6**4

Probably to see if he could do it himself? Or maybe just felt like doing it rather than looking for a module :) I wrote something very similar except that you told it the number of dice you wanted to roll and how many sides to use. Nothing fancy, just a variation on an exercise I'd done for a Perl class.
---
"Ex Libris un Peut de Tout"

#! /usr/bin/perl -w
use strict;

my @dist = dice_distribution(
  sides => 6,
  number => 4,
  slice => [1, 2, 3],
);

my $average = sum( map $_*$dist[$_], 0..$#dist ) / sum(@dist);
print "The average is $average\n";

sub dice_distribution {
  my %args = @_;

  my $sides = $args{sides} || 6;
  my $number = $args{number} || 3;
  my $slice = $args{slice} || [0..($number - 1)];

  my @distribution;
  nested_for(
    sub {
      my @dice = (sort {$a <=> $b} @_)[@$slice];
      $distribution[ sum(@dice) ]++;
    }, map [1..$sides], 1..$number,
  );
  # Quiet warnings
  $_ ||= 0 for @distribution;
  return @distribution;
}

sub sum {
  my $sum = 0;
  $sum += $_ for @_;
  return $sum;
}

sub nested_for {
  bind_loops(@_)->();
}

sub bind_loops {
  my $fn = shift;
  my $range = shift;
  my $sub = sub {$fn->($_, @_) for @$range};
  return @_ ? bind_loops($sub, @_) : $sub;
}
[download]

(Yes, a key part of this bears a suspicious resemblance to Re (tilly) 1 (perl): What Happened...(perils of porting from c). If you are puzzled over how this works, figuring out that first may be a good idea.)

If anyone has the general formula, I'd be curious to see it.

#!/your/perl/here

# DND dice stats
# give expected value for $dice_num, with $dice_sides, dropping the lo
+west $dice_drop die.

use strict;
use warnings;

our $dice_num  = ( shift or 4 );
our $dice_side = ( shift or 6 );
our $dice_drop = ( @ARGV ? shift : 1 );

our $total;
our $count;

foreach my $index ( 0 .. ( $dice_side**$dice_num ) - 1 )
{
    use integer;
    
    my @digits;
    foreach my $digit ( 0 .. $dice_num - 1 )
    {
        $digits[$digit] = ( $index / ( $dice_side ** $digit ) ) % $dic
+e_side + 1;
    }
    
    my $sum;
    foreach my $die ( ( sort @digits )[$dice_drop..$dice_num-1] )
    {
        $sum += $die;
    }
    
    $total += $sum;
    $count++;

#   use this for intermediate results    
#    print "(@digits) sum=$sum, t=$total, c=$count\n";
}

our $avg = $total/$count;
print "${dice_num}d${dice_side}-${dice_drop}: $total/$count=$avg\n";

__END__
[download]

>dnd.pl 4 6
4d6-1: 15869/1296=12.2445987654321
[download]

>dnd.pl 2 6 0
2d6-0: 252/36=7
[download]

Then the code looks like this:

my ($sum, $rolls) = (0,0);
for my $hi (1..6) {
  for my $mid (1..$hi) {
    for my $low (1..$mid) {
      # The drop value can be anything from 1..$low
      $sum += ($hi + $mid + $low) * $low;
      $rolls += $low;
    }
  }
}
printf "The average value is %g\n", $sum/$rolls;
[download]

The hole in your reasoning is that you count, for instance, 3-3-3-3 as one possibility, and also 1-3-4-6 as one possibility.

In fact 3-3-3-3 can only happen one way, while 1-3-4-6 can happen 24 ways.

Right you are. Putting the possible combinations into play, I finally came up with a program that gets the right answer, and can be used for any number of sides (though I did not generalize it to be any number of dice, nor any number of discards -- it is possible to do so, but it's messy enough already). For 6 sided dice, it is probably working harder than the explicit method, but for 20 sided dice, it is much faster.

In the code, L is the low value for the roll. The number of distinct permutations possible varies, depending on how many times L is repeated, and the average value for the permutations also changes based on that.

my $sides = 16;
my ($total, $rolls) = (0,0);
foreach my $L (1..$sides) {
  # Start with all others = $L
  my $combos = 1;
  my $sum = $L * 3;
  $rolls += $combos;
  if ($sides > $L) {
    # How many repeat $L twice, with one higher?
    $combos = 4 * ($sides-$L);
    my $avg = 2 * $L + ($L+1+$sides)/2;
    $rolls += $combos;
    $sum   += $avg * $combos;
    # How many repeat $L once, with two higher?
    $combos = 6 * ($sides-$L)**2;
    $avg = $L + ($L+1+$sides);
    $rolls += $combos;
    $sum   += $avg * $combos;
    # How many do not repeat $L?
    $combos = 4 * ($sides-$L)**3;
    $avg = 3*($L+1+$sides)/2;
    $rolls += $combos;
    $sum   += $avg * $combos;
  }
  printf "%d combos of three dice >= $L averaging %g\n", $combos, $sum
+/$combos;
  $total += $sum;
}
printf "Average of $rolls rolls is %g\n", $total/$rolls;

# Explicit method included for check
$sum = $rolls = 0;
for $i (1..$sides) {
  for $j (1..$sides) {
    for $k (1..$sides) {
      for $l (1..$sides) {
        my $min = $l;
        for ($i, $j, $k) { $min = $_ if $_ < $min }
        $sum += $i + $j + $k + $l - $min;
        ++$rolls;
      }
    }
  }
}
printf "Average of $rolls rolls is %g\n", $sum/$rolls;
[download]

---

The PerlMonk tr/// Advocate

Suggestions for how to make this smaller and Perlisher are welcome. I'm sure this can be compressed to a one-liner, somehow...

Heres my go at a generic version. Returns the average of NdS Drop X. N,S should be larger than 0 and X non-negative. eg: avg_die(4,6,1) gives your result (in 162 chars, including sub decl. :-)

#!perl -l
use strict;
use warnings;
$|++;
#162 chars, including sub decl.
sub A{my($d,$s,$l,$y,$c,$t,$z)=@_;$c||=\$z;if(!$d){
$t+=$_ for(sort{$a<=>$b}@$y)[$l..$#$y];$$c++}else{$t+=A
($d-1,$s,$l,[@{$y||[]},$_],$c)for 1..$s}$y?$t:$t/$z}
[download]

print A(4,6,1);
print avg_roll(4,6,1);
__END__
12.2445987654321
12.2445987654321
[download]

Update: 150 chars.

sub B{my($d,$s,$l,$c,@y,$t,$z)=@_;$c||=\$z;if(!$d){$t+=$_
for(sort{$a<=>$b}@y)[$l..$#y];$$c++}else{$t+=B($d-1,$s,$l,
$c,@y,$_)for 1..$s}@y?$t:$t/$z}
[download]

:-)