Beefy Boxes and Bandwidth Generously Provided by pair Networks
Just another Perl shrine

RFC: Emulating the monastery voting system

by biohisham (Priest)
on Sep 10, 2015 at 12:27 UTC ( #1141530=perlmeditation: print w/replies, xml ) Need Help??

Out of admiration for the PM voting and ranking system described in votes; I am inspired to suggest an implementation along its lines on a website being developed with a team of my friends. So as a proof of concept I wrote this interactive code that accepts: a member's reputation, (u)pvotes & (d)ownvotes, average likes per week as well as age of the node; then decides whether the number of u's or d's would result in reputation gain or loss relative to the current reputation.

As it is the code tests fine but I feel it could still use comments and anecdotal wisdom from the monks here, hence I posted it in Meditations.

use strict; use warnings; use Readonly; use Getopt::Long; use Scalar::Util::Numeric qw(isint); #age and avg_xp are calculated at the start of everyday. #The avg_xp=sum(XP)/#nodes in the past 7 days. #The program takes these two values in addition to #likes and #unlikes + to dynamically compute reputation gains and losses. #Input for current reputation is prompted when it is time to update th +e reputation. my ($age, $avg_xp,$gained_rep, $lost_rep); my ($upvotes, $downvotes, $total_rep); my $current_rep; #variable to hold the current user reputation from th +e user page. my $vote; #a listener:either (u)pvote or (d)ownvote. Readonly::Scalar my $args =>4; #program accepts two args & two vals if(@ARGV != $args){die "syntax error: perl --age n -- +avg_xp n\n";} GetOptions( "age=i"=>\$age, "avg_xp=i"=>\$avg_xp, )or die "syntax error: perl --age n --avg_xp n\n" +; print "enter u for upvote or d for downvote\n"; while($vote=<>){ chomp $vote; if($vote =~/^u$/i){ $upvotes++; analyze_upvotes($age, $upvotes); }elsif($vote=~/^d$/i){ $downvotes++; analyze_downvotes($age,$downvotes); }else{ print "ERROR: enter u for upvote or d for downvote\n"; } } sub analyze_upvotes{ my $node_age=shift; my $like_counter=shift; printf "you have %d likes\n",$like_counter; if($like_counter==1){#reward the first upvote $gained_rep=1; rep_update($gained_rep,"gain", $like_counter); $gained_rep=0; } if($age>2 && $like_counter>1){ #nodes older than two weeks get 1/5 + rep increase $gained_rep+=1/5; if(isint $gained_rep){ #reputation is reported when gained +reputation sums to a whole number rep_update($gained_rep,"gain", $like_counter); $gained_rep=0; } }elsif($age<=2 && $like_counter>1){ #rep for nodes < 2 weeks o +ld is calculated with avg_xp perspective if($like_counter<=$avg_xp){ $gained_rep+=1/3; } elsif($like_counter>$avg_xp && $like_counter<=2*$avg_x +p){ $gained_rep+=1/2; } elsif($like_counter>2*$avg_xp && $like_counter<=3*$avg +_xp){ $gained_rep+=2/3; } elsif($like_counter>3*$avg_xp && $like_counter<=4*$avg +_xp){ $gained_rep+=3/4; } elsif($like_counter>4*$avg_xp){$gained_rep+=1; $gained +_rep=int $gained_rep; } if(isint $gained_rep){ if($current_rep-$gained_rep==0){ #for when cur_rep +=1 and gained_rep=1; rep_update(1,"gain", $like_counter); }else{ rep_update($gained_rep, "gain", $like_coun +ter); } $gained_rep=0; } } } sub analyze_downvotes{ my $node_age=shift; my $unlike_counter=shift; printf "you have %d unlikes\n", $unlike_counter; if($age<=2){ if($unlike_counter<= 3*$avg_xp){ $lost_rep+=1/3; } elsif($unlike_counter > 3*$avg_xp && $unlike_counter <= 4* +$avg_xp){ $lost_rep+=1/4; } elsif($unlike_counter > 4*$avg_xp){ $lost_rep+=0; } if(isint $lost_rep){ rep_update($lost_rep, "loss", $unlike_counter); $lost_rep=0; } }elsif($age>2){ $lost_rep+=0;} } sub rep_update{ my $rep_gain_loss=shift; my $status=shift; my $like_unlike_counter=shift; print "what is the current user reputation?\n"; $current_rep=<>; chomp $current_rep; if($status eq "gain"){ my $total_gain=$current_rep + $rep_gain_loss; printf "you gained %d points\nyour reputation is %d\n", $rep_g +ain_loss, $total_gain; }elsif($status eq "loss"){ my $total_loss=$current_rep-$rep_gain_loss; printf "you lost %d reputation points\nyour reputation is +%d\n", $rep_gain_loss,$total_loss; } }

I am also thinking about changing the way loss of reputation is done by basing it on a variable (say avg_unlike_xp) similar to the avg_xp that I currently use for calculating gain/loss or reputation. If I did this I won't be that benevolent of a dictator any more though as I could risk over-penalizing members.

Something or the other, a monk since 2009

Replies are listed 'Best First'.
Re: RFC: Emulating the monastery voting system
by ww (Archbishop) on Sep 11, 2015 at 21:34 UTC

    Looks like you're having fun.

    But how do you plan to implement a designated 'butt of the downvotes' and will you be creating anonymous users to cast actual votes against that downvote-butt?>


    If you didn't program your executable by toggling in binary, it wasn't really programming!

    check Ln42!

      Oh yeah, I am having heaps of fun and a sense of purpose. Similar to what I feel when I first joined the Monastery as a Perl rookie. The website is about researchers and mentoring of junior students through a QA like forum, imparting them with soft skills, communication skills and networking: effectively making use of the collective wisdom of all members. Anonymous users should not be given a lot of freedom on what they can do around particularly with regard to voting. Voting will be a privilege given to registered members only. That way I can avoid encouraging malicious downvoting.

      Regarding the 'butt of the downvotes'; I don't think I fully understand you there. If you mean by that my idea of calculating reputation loss based on the average downvotes for the past week, my assumption is that the website users won't be giving a lot of downvotes therefore the average will be quite low and in that case it will be quickly surpassed by the downvotes that one node may receive, resulting in over-penalizing the OP. So I'd probably avoid that form of cruelty altogether.

      Something or the other, a monk since 2009
        A reply falls below the community's threshold of quality. You may see it by logging in.
A reply falls below the community's threshold of quality. You may see it by logging in.

Log In?

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: perlmeditation [id://1141530]
Approved by Corion
Front-paged by ww
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others avoiding work at the Monastery: (2)
As of 2021-10-18 06:57 GMT
Find Nodes?
    Voting Booth?
    My first memorable Perl project was:

    Results (72 votes). Check out past polls.