XP is just a number PerlMonks

### Re: Bag uniform distribution algorithms

by BrowserUk (Pope)
 on Apr 25, 2013 at 16:45 UTC ( #1030697=note: print w/replies, xml ) Need Help??

in reply to Bag uniform distribution algorithms

You could try something like this:

```#! perl -slw
use strict;
use Data::Dump qw[ pp ];

sub gen {
my \$href = shift;
my @kByV = sort{ \$href->{ \$b } <=> \$href->{ \$a } } keys %\$href;
my @dist = ( \$kByV[0] ) x \$href->{ \$kByV[0] };
shift @kByV;
while( @kByV ) {
my \$k = shift @kByV;
my \$v = \$href->{ \$k };
my \$n = int( @dist / ( \$v+1 ) );
my \$p = \$n * \$v;
splice( @dist, \$p, 0, \$k ), \$p -= \$n for reverse 1 .. \$v;
}
return \@dist;
}

pp gen( { A => 4, B => 2, C => 3, D => 1 } );
pp gen( { A => 5, B => 4, C => 3, D => 2, E => 1 } );

Outputs:

```C:\test>1030688.pl
["A", "C", "B", "A", "D", "C", "B", "A", "C", "A"]
["A", "B", "C", "A", "D", "B", "C", "E", "A", "B", "D", "C", "A", "B",
+ "A"]

With the rise and rise of 'Social' network sites: 'Computers are making people easier to use everyday'
Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
"Science is about questioning the status quo. Questioning authority".
In the absence of evidence, opinion is indistinguishable from prejudice.

Create A New User
Node Status?
node history
Node Type: note [id://1030697]
help
Chatterbox?
and all is quiet...

How do I use this? | Other CB clients
Other Users?
Others imbibing at the Monastery: (5)
As of 2018-02-25 16:21 GMT
Sections?
Information?
Find Nodes?
Leftovers?
Voting Booth?
When it is dark outside I am happiest to see ...

Results (314 votes). Check out past polls.

Notices?