This code is simply to test the banacer sub routine. This sub takes a hash containing some sort of process_id as the key, and a process run time (i used seconds), and a number of split processes. This is used to balance programs which run multiple smaller processes into logical groupings.
Another use for this might be balancing large files (names as keys, sizes as values) into a number of directories/partitions.
#!/usr/bin/perl use strict; use vars qw(%PROCESS_TIMES); ## process_id => run_time_in_sec %PROCESS_TIMES = ( 117 => '335', 118 => '389', 119 => '005', 120 => '201', 130 => '622', 131 => '090', 132 => '110', 133 => '245', 134 => '010', 135 => '075', 136 => '104', ); ######################## Tester Code ##################### my @AoA = &balancer(\%PROCESS_TIMES,4); ## Verify if worked : my $a = 0; my $perc_tot = 0; my $trt = &bucket_run_time([values %PROCESS_TIMES]); foreach my $queue (@AoA) { my @foo = (); foreach my $pid (@$queue) { push(@foo,$PROCESS_TIMES{$pid}); } my $brt = &bucket_run_time(\@foo); printf("Balanced Run Time %d : %d (%3.2f %%)\n",$a,$brt,($brt/$trt +*100)); $a++; $perc_tot += ($brt/$trt*100); } print " That is $perc_tot %\n"; exit(0); ################### end tester code ######################### # @AoA = balancer(\%hash,$X); # Given a hash ref with process id's as keys, and # run time in second as value, balance into X groups # of balanced run time. Returns an array with X # elemnts, which are the array references. sub balancer { my ($href,$buckets) = @_; my @output_AoA = (); if (! defined($href) || ! defined($buckets) || $buckets < 1) { return undef; } my $total_run_time = &bucket_run_time([values %{$href}]); my $bucket_target = $total_run_time/$buckets; my %rt_hash = &rev_hash(%{$href}); BUCKET: for (my $i = 0;$i < $buckets;$i++) { my $current_run_time = 0; RUNTIME: foreach my $run_time (reverse(sort(keys(%rt_hash)))) +{ # largets to smallest, take first to fit ## Handle runtime > bucket size if ($run_time > $bucket_target) { push(@{$output_AoA[$i]},pop(@{$rt_hash{$run_time}})); if (scalar @{$rt_hash{$run_time}} == 0) { # no more with that run time, remove delete $rt_hash{$run_time}; } next BUCKET; } if ( ($current_run_time+$run_time) < $bucket_target) { # add it $current_run_time += $run_time; push(@{$output_AoA[$i]},pop(@{$rt_hash{$run_time}})); if (scalar @{$rt_hash{$run_time}} == 0) { # no more with that run time, remove delete $rt_hash{$run_time}; } } else { # bucket full } } } return(@output_AoA); } ## used by balancer sub rev_hash { my (%input) = @_; my %output = (); foreach my $k (keys %input) { push(@{$output{$input{$k}}},$k); } return(%output); } ## used for tester code sub bucket_run_time { my ($aref) = @_; my $tot = 0; for (@{$aref}) { $tot+=$_; } return($tot); }

In reply to balancer (process time/file size) by MZSanford

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post, it's "PerlMonks-approved HTML":



  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.