# # Code for enumerating coin and dice throws # # Copyright 2003 Mark Jason Dominus (mjd@plover.com) # Copyright abandoned 2003 11 08 # This code is in the public domain # sub gen_table { my ($N, $C) = @_; my @table; my $total = $C**$N; my $check = 0; for my $pat (patterns($N)) { my $f = frequency($N, $C, $pat); next if $f == 0; push @table, [pattern_to_string($pat), $f]; $check += $f; } if ($check != $total) { die "Total failed check\n"; } @table; } sub patterns { my $N = shift; my $max = shift || $N; my @result; return if $N < 0; return [] if $N == 0; for my $i (reverse 1 .. $max) { push @result, map [$i, @$_], patterns($N-$i, $i); } @result; } sub pattern_to_string { my $pat = shift; my @pat = @$pat; my $l = 'A'; my $s = ""; while (@pat) { $s .= ($l x (shift @pat)); $l++; } $s; } sub R { my $pat = shift; prod(map fact($_), @$pat); } sub B { my $pat = shift; my @count; $count[$_]++ for @$pat; prod(map fact($_), @count); } sub green { my ($C, $pat) = @_; my $T = 1; $T *= $C-- for @$pat; $T; } sub frequency { my ($N, $C, $pat) = @_; fact($N) / R($pat) / B($pat) * green($C, $pat); } sub prod { my $T = 1; for (@_) { $T *= $_ } $T; } BEGIN { my @fact = (1); sub fact { my $n = shift; return $fact[$n] if defined $fact[$n]; $fact[$n] = $n * fact($n-1); } } 1;