scratchpad
crenz
<br /><a HREF="/index.pl?node_id=153046">Professional Employees and Works for Hire</a>
<br /><a HREF="/index.pl?node_id=147962">Server Status/ Thank you Pair.com</a>
<br /><a HREF="/index.pl?node_id=107771">Win32::OLE Type Library Browser</a>
<p>from [no_slogan]:</p>
<code>
# randomly choose subsets of items from a set, without replacement.
# items in the set are not equally probable.
use strict;
use warnings;
# recursively build a balanced binary search tree of weighted items.
# this is not terribly efficient, and could be improved.
sub build_tree {
my ($weights) = @_;
my @items = sort keys %$weights;
return build_tree_rec($weights, @items);
} # build_tree
sub build_tree_rec {
my ($weights, @items) = @_;
return unless @items;
my $mid = int(@items / 2);
my $tree = { };
$tree->{item} = $items[$mid];
$tree->{left} = build_tree_rec($weights, @items[0..($mid-1)]);
$tree->{right} = build_tree_rec($weights, @items[($mid+1)..$#items]
+);
$tree->{weight} = $weights->{ $tree->{item} };
calc_weight($tree);
return $tree;
} # build_tree_rec
# change the weight of an item in the tree.
# this is written non-recursively for speed.
sub change_weight {
my ($item, $weight, $tree) = @_;
my @path;
while ($tree && $item ne $tree->{item}) {
push @path, $tree;
if ($item lt $tree->{item}) {
$tree = $tree->{left};
}
else {
$tree = $tree->{right};
}
}
return unless $tree; # item not found
$tree->{weight} = $weight;
# recalculate weights as necessary
calc_weight($tree);
while (@path) {
$tree = pop @path;
calc_weight($tree);
}
} # change_weight
# calculate the total weight of a tree. assumes that the weights
# of the left and right subtrees have already been calculated.
sub calc_weight {
my ($tree) = @_;
my $left = $tree->{left};
my $right = $tree->{right};
$tree->{total_weight} = $tree->{weight};
$tree->{total_weight} += $left->{total_weight} if $left;
$tree->{total_weight} += $right->{total_weight} if $right;
} # calc_weight
# randomly choose an item from the tree.
sub choose_item {
my ($tree) = @_;
my $val = rand($tree->{total_weight});
while ($val >= $tree->{weight}) {
$val -= $tree->{weight};
my $left = $tree->{left};
if ($left && $val < $left->{total_weight}) {
$tree = $left;
}
else {
$val -= $left->{total_weight} if $left;
my $right = $tree->{right};
if ($right && $val < $right->{total_weight}) {
$tree = $right;
}
else {
# if we get here, there has been some funny round-off in $val.
# this should be very unlikely. don't search any further
# or we might move into a branch with zero weight.
last;
}
}
} # while $val
return $tree->{item};
} # choose_item
# randomly choose several different items from the tree.
# you need to pass in the weights of the items, so they can be
# restored at the end. this is inconvenient, but could be fixed.
# this runs in O(k*log n) time, where there are n items
# in the tree and k are being chosen.
sub choose_items {
my ($num, $weights, $tree) = @_;
my @items;
for (1 .. $num) {
my $item = choose_item($tree);
push @items, $item;
change_weight($item, 0, $tree); # don't pick this item again!
}
foreach my $item (@items) {
change_weight($item, $weights->{$item}, $tree);
}
return @items;
} # choose_items
# exercise the trees a bit.
my %weights = (
a => 1,
b => 1,
c => 1.5,
d => .5,
);
my $tree = build_tree(\%weights);
for (1..20) {
my @items = choose_items(2, \%weights, $tree);
print "@items\n";
}
</code>
<br /><a HREF="/index.pl?node_id=242974">Fun with Hook::LexWrap and code instrumentation</a>
<br /><a HREF="/index.pl?node_id=158482">Rolling a biased die</a>
<br /><a HREF="/index.pl?node_id=242995">Re: Re: Perl program for updating code parts from web ?</a>
<br /><a HREF="/index.pl?node_id=222465">TinyPerl for Win32</a>
<P>[id://72241] pmxml stuff</p>
http://www.perlmonks.org/index.pl?node_id=258312 -- loc counter
http://www.perlmonks.org/?node_id=444844 -- untaint