my %options;
GetOptions(\%options,
'option=s@',
+ 'default_option|default-option!',
+ 'quorum=i',
);
if (not exists $options{option} or not ref($options{option}) or
@{$options{option}} < 2
}
my @options;
for my $option (@{$options{option}}) {
- my ($key,$name,$majority) = split /:/,$option;
+ my ($key,$name,$majority) = $option =~ /^\s*([^:]+?)\s*:\s*(.+?)\s*(?::(\d+))?$/;
$majority //= 1;
push @options,{key => $key,
name => $name,
majority => $majority,
};
}
- winner(options=>\@options);
+ winner(options=>\@options,
+ default_option => exists $options{default_option} ? $options{default_option} : 1,
+ quorum => exists $options{quorum} ? $options{quorum} : 2,
+ );
}
sub encode_base64{
tally_fh => {type => HANDLE,
optional => 1,
},
+ default_option => {default => 1,
+ type => BOOLEAN,
+ },
},
);
# options is an array to keep it ordered
}
# The constitution defines the maximum value of K to be 5
- my $K = 2; # Math::BigFloat->new($params{quorum});
+ my $K = $params{quorum};
# 1. Given two options A and B, V(A,B) is the number of voters who
# prefer option A over option B.
if (not defined $params{tally_fh}) {
$params{tally_fh} = \*STDIN;
}
+ # header been output?
+ my $header_output = 0;
# This is where we get our input data from
while (defined ($_ = $params{tally_fh}->getline)) {
} elsif (m/^(.+) # the voter, can have spaces
\s*:\s+ # needs a colon and a space
((?:[$valid_options] # the vote
- \s*(?:,|=|<)?\s*)*) # allow < and , or =
+ \s*(?:,|=|>)?\s*)*) # allow > and , or =
\s*$/x # useless trailing spaces
) {
$voter = $1;
my $current_rank = 1;
my %option_rank;
while ($vote =~ /([$valid_options]) # the vote
- \s*((?:,|=|<)?)\s*/xg) {
+ \s*((?:,|=|>)?)\s*/xg) {
my ($option,$relationship) = ($1,$2);
$option_rank{$option} = $current_rank;
if ($relationship ne '=') {
}
$vote = '';
for my $opt (@options) {
- $vote .= exists $option_rank{$opt->{key}} ? $option_rank{$opt->{key}} : '-';
+ $vote .= exists $option_rank{$opt->{key}} ? $number_to_option{$option_rank{$opt->{key}}} : '-';
+ }
+ if (not $header_output) {
+ print {$RESULTS} "/--".join("",map {$_->{key}} @options)."\n";
+ $header_output = 1;
}
print {$RESULTS} "V: $vote $voter\n";
} else {
- print STDERR "ignoring line '$_'; this is probably wrong!";
+ print STDERR "ignoring line '$_'; this is probably wrong!\n";
next;
}
printf {$RESULTS} "Option %s ", $order_to_options{$row + 1}{key};
for my $col (0..($max_choices - 1)) {
if ($row == $col) {
- printf {$RESULTS} " ", $Beat_Matrix[$row][$col];
+ print {$RESULTS} " ";
} else {
printf {$RESULTS} " % 4d ", $Beat_Matrix[$row][$col];
}
my %Drop = ();
- foreach my $i (0..($max_choices - 2)) {
- if ($K > $Beat_Matrix[$i][$max_choices - 1]) {
- $Drop{$i}++;
- print {$RESULTS} "Dropping Option", $order_to_options{$i + 1}{key},
- " \"", $order_to_options{$i + 1}{name},
- "\" because of Quorum\n";
- } else {
- print {$RESULTS} "Option ", $order_to_options{$i + 1}{key},
- " Reached quorum: $Beat_Matrix[$i][$max_choices - 1] > $K\n";
+ if ($params{default_option}) {
+ foreach my $i (0..($max_choices - 2)) {
+ if ($K > $Beat_Matrix[$i][$max_choices - 1]) {
+ $Drop{$i}++;
+ print {$RESULTS} "Dropping Option ", $order_to_options{$i + 1}{key},
+ " \"", $order_to_options{$i + 1}{name},
+ "\" because of Quorum ($K > $Beat_Matrix[$i][$max_choices - 1])\n";
+ } else {
+ print {$RESULTS} "Option ", $order_to_options{$i + 1}{key},
+ " Reached quorum: $Beat_Matrix[$i][$max_choices - 1] >= $K\n";
+ }
}
+ print {$RESULTS} "\n\n";
}
- print {$RESULTS} "\n\n";
# Record Majority
my %Ratio = ();
# 2. An option A defeats the default option D by a majority ratio N,
- # if V(A,D) is strictly greater than N * V(D,A).
+ # if V(A,D) is greater or equal to N * V(D,A) and V(A,D) is strictly
+ # greater than V(D,A).
# 3. If a supermajority of S:1 is required for A, its majority ratio
# is S; otherwise, its majority ratio is 1.
# Any (non-default) option which does not defeat the default option
my $ratio = 1.0 * $Beat_Matrix[$i][$max_choices - 1] /
$Beat_Matrix[$max_choices - 1][$i];
$Ratio{$i} = sprintf("%.2f", $ratio);
- if ($ratio < $order_to_options{$i + 1}{majority}) {
+ if ($ratio < $order_to_options{$i + 1}{majority} or $ratio <= 1) {
# If the next line is commented out, we get a more verbose set of results
$Drop{$i}++;
print {$RESULTS} "Dropping Option ", $order_to_options{$i + 1}{key},
" because of Majority. ($ratio)";
- printf {$RESULTS} " %6.3f (%d/%d) < %d\n",
+ my $comparison_sign = $order_to_options{$i + 1}{majority} == 1 ? '<=' : '<';
+ printf {$RESULTS} " %6.3f (%d/%d) $comparison_sign %d\n",
$ratio, $Beat_Matrix[$i][$max_choices - 1],
$Beat_Matrix[$max_choices - 1][$i],
$order_to_options{$i + 1}{majority};
} else {
print {$RESULTS} "Option ", $order_to_options{$i + 1}{key}, " passes Majority.";
print {$RESULTS} " ";
- printf {$RESULTS} " %6.3f (%d/%d) >= %d\n",
+ my $comparison_sign = $order_to_options{$i + 1}{majority} == 1 ? '>' : '>=';
+ printf {$RESULTS} " %6.3f (%d/%d) $comparison_sign %d\n",
$ratio, $Beat_Matrix[$i][$max_choices - 1],
$Beat_Matrix[$max_choices - 1][$i],
$order_to_options{$i + 1}{majority};