#!/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); }