Beefy Boxes and Bandwidth Generously Provided by pair Networks
good chemistry is complicated,
and a little bit messy -LW
 
PerlMonks  

Weighted Calculation

by dirtdog (Beadle)
on May 01, 2014 at 14:14 UTC ( #1084635=perlquestion: print w/ replies, xml ) Need Help??
dirtdog has asked for the wisdom of the Perl Monks concerning the following question:

Hi Monks,

I'm having a very hard time with the execution of weighting. In my code, I have multiple users, but only 2 of them (in this case) have a weighting. Drew, should get half (.5) of the work of the other non-weighted users...And Tim should get double the work. I'm not getting my desired result. Tim ends up getting a lot more than double the work.

#!/usr/bin/env perl my %user_weight = (DREW => .5, TIM => 2,); my $roundup; my $tot_per_user; my $tot_events; my $tot_users; undef %userMax4type; my @tmp; my $tmp=0; my $weight_tot=0; my %USERS; while (<DATA>) { # Stuff data into Hash and get count of total events and users my $aref = [split]; $USERS{$aref->[0]} = $aref->[1]; $tot_events += $aref->[1]; $tot_users++; } foreach ( keys %USERS ) { #check if a User has an assigned weight and perform calculatio +n if ( exists($user_weight{$_}) ) { $tot_per_user = $tot_events/$tot_users * $user_weight{ +$_}; $roundup=sprintf("%.0f", $tot_per_user); print "roundup for $_ is: $roundup\n"; $weight_tot += $roundup; } else { #keep track of those users who do not have a weighting push @tmp, $_; $tmp++; } } #perform calculation on non-weighted users foreach (@tmp) { $tot_per_user = ($tot_events-$weight_tot)/$tmp * 1; $roundup=sprintf("%.0f", $tot_per_user); print "roundup for $_ is: $roundup\n"; } __DATA__ TIM 150 JOE 124 JACK 111 KATE 145 DREW 177

Does anyone know of a better way to redistribute work based on a weighting system

any help is much appreciated

thanks

Comment on Weighted Calculation
Download Code
Re: Weighted Calculation
by moritz (Cardinal) on May 01, 2014 at 14:50 UTC

    I don't understand why you make a case distinction for users with and without weight. Just assume that that users without one have weight 1.

    Also I don't understand if there are any constraints related to how work can be redistributed. If not, simply add all the weights (and 1 for unweighted users), divide the total work units by that sum, and then you have the amount of work a "normal" user has to. Scale it by each users's weight to get the work she has to do.

    #!/usr/bin/env perl use 5.010; use strict; use warnings; use List::Util qw/sum/; my %user_weight = (DREW => .5, TIM => 2,); my $total_work; while (<DATA>) { my @cols = split; $user_weight{$cols[0]} //= 1; $total_work += $cols[1]; } my $total_weights = sum values %user_weight; my $work_per_unit = $total_work / $total_weights; for my $u (sort keys %user_weight) { printf "%s: %.2f\n", $u, $work_per_unit * $user_weight{$u}; } __DATA__ TIM 150 JOE 124 JACK 111 KATE 145 DREW 177

      thanks for weighing in Moritz..pun intended..but i can't seem to get this to work. I know what you're doing with the following statement, but for some reason it's not working. Is the syntax correct?

       $user_weight{$cols[0]} //= 1;
        This a relatively new feature. Which version of Perl are you using?

        If your version is old, try this line instead:

        $user_weight{$cols[0]} = 1 unless defined $user_weight{$cols[0]} ;

        ..but for some reason it's not working. Is the syntax correct?

        If you are using perl version 5.10.0 and above, it should work. Of course the syntax is correct.
        However, this also work:     $user_weight{$cols[0]} ||= 1;

        The Defined-or operator was implemented in perl 5.10.0 check Defined-or-operator

        Update:

        Oops, I didn't see tye answer before posting mine, I had this post opened, then got distracted with some other things before submitting my post later. Only to refresh and see that mine post was in a way similar to his.
        +1 tye all the same.

        If you tell me, I'll forget.
        If you show me, I'll remember.
        if you involve me, I'll understand.
        --- Author unknown to me
Re: Weighted Calculation
by Laurent_R (Parson) on May 01, 2014 at 15:05 UTC
    If I understand correctly what you are trying to do, you have a total amount of work and want to allocate it in such a way that the work is allocated equally between the non-weighted workers, but Drew gets half of what one non weighted worker gets and Tim twice as much. Just compute the maths before starting: 3 workers get each 1 part, Drew gets 0.5 part, and Tim gets two parts. Total number of parts: 3 + 0.5 + 2 = 5.5. Just calculate the total amount of work, divide it by 5.5 to get the value of each part, and then assign non weighted workers 1 part, Drew 0.5 part and Tim two parts.
Re: Weighted Calculation
by Laurent_R (Parson) on May 01, 2014 at 15:31 UTC
    This a quick implementation of the algorithm description I gave before:
    #!/usr/bin/env perl use strict; use warnings; my %user_weight = (DREW => .5, TIM => 2,); my ($tot_users, $tot_non_weighted, $tot_events); while (<DATA>) { # Stuff data into Hash and get count of total events and users my ($user, $val) = split; $tot_events += $val; $tot_users++; $tot_non_weighted ++ unless exists $user_weight{$user}; } my $number_of_weighed_parts; $number_of_weighed_parts += $_ for values %user_weight; my $indiv_part = $tot_events / ($tot_non_weighted + $number_of_weighed +_parts); print "The $tot_non_weighted non_weighted workers get each $indiv_part +\n"; for my $weighted_user (keys %user_weight) { print "$weighted_user gets ", $indiv_part * $user_weight{$weighted +_user}, "\n"; } __DATA__ TIM 150 JOE 124 JACK 111 KATE 145 DREW 177
    And this prints the following output:
    $ perl weight.pl The 3 non_weighted workers get each 128.545454545455 DREW gets 64.2727272727273 TIM gets 257.090909090909
    which seems correct (at least if I understood correctly what you are trying to do). You would probably want to add some rounding, but I leaves that to you.

    Edit 15:41 UTC: corrected a bug in the above code and the output.

    Edit2 16:40 UTC: I had not seen moritz's solution when I posted my messages above. My proposed solution (be it in English or in Perl code) is to a large extent equivalent, sorry for posting almost the same thing.

      Thanks, but the total initial amount of work to be divided is 707. Your results equal 775. So it's not quite adding up.

        Yes, you are right, there was a small bug (using the wrong variable for dividing the total work), but the strange thing is that I corrected it before you posted your message. Well, anyway, now the total is correct, I believe.

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://1084635]
Approved by marto
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others studying the Monastery: (9)
As of 2014-11-23 13:40 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    My preferred Perl binaries come from:














    Results (132 votes), past polls