scripts/pocket-devotee

   1 #!/usr/bin/perl -w
   2 #                              -*- Mode: Cperl -*-
   3 # pocket_devotee ---
   4 # Author           : Manoj Srivastava ( srivasta@glaurung.green-gryphon.com )
   5 # Created On       : Thu Oct 16 12:08:43 2003
   6 # Created On Node  : glaurung.green-gryphon.com
   7 # Last Modified By : Manoj Srivastava
   8 # Last Modified On : Sat Mar 10 09:42:54 2007
   9 # Last Machine Used: glaurung.internal.golden-gryphon.com
  10 # Update Count     : 203
  11 # Status           : Unknown, Use with caution!
  12 # HISTORY          :
  13 # Description      :
  14 # arch-tag: 1a48504a-0668-4790-aa72-d4359a3c41e2
  15 #
  16 # This program is free software; you can redistribute it and/or modify
  17 # it under the terms of the GNU General Public License as published by
  18 # the Free Software Foundation; either version 2 of the License, or
  19 # (at your option) any later version.
  20 #
  21 # This program is distributed in the hope that it will be useful,
  22 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  23 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  24 # GNU General Public License for more details.
  25 #
  26 # You should have received a copy of the GNU General Public License
  27 # along with this program; if not, write to the Free Software
  28 # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  29
  30 #
  31
  32 use warnings;
  33 use strict;
  34
  35 require 5.005;
  36 use Carp qw(carp croak);
  37 use Params::Validate qw(validate_with :types);
  38 use Getopt::Long;
  39 #use Math::BigInt ':constant';
  40 #use Math::BigFloat;
  41
  42 =head1 NAME
  43
  44 pocket_devotee - Given a tally sheet, calculate the Condorcet winner
  45
  46 =cut
  47
  48 =head1 SYNOPSIS
  49
  50 pocket_devotee --option 'A:foo' --option 'B:bar' < tally_sheet
  51 pocket_devotee --num-options 3 < tally_sheet
  52
  53 =cut
  54
  55 =head1 DESCRIPTION
  56
  57 Produce the results, taking into consideration the tally, quorum
  58 requirements, and the per option majority requirements, if any.
  59 This routine is the heart of the voting system. It takes into account
  60 quorum requirements (reading the output file produced by dvt-quorum),
  61 and also the configured majority requirements, if any.
  62
  63 It reads the tally sheet produced by dvt-tally, and creates the
  64 initial beat matrix; and the pairwise defeat list, and finally the
  65 schwartz set. If there are defeats between the members of the schwartz
  66 set, it drops the weakest defeat and repeats, until there is a winner.
  67
  68 It puts the results in the configured output file.
  69
  70 =cut
  71
  72 =head2 Internal Implementation
  73
  74 =head3 winner
  75
  76 This is the workhorse routine.
  77 This routine pays attention to the configuration variables
  78 Quorum_File, Tally_File, Max_Choices, and Results.
  79
  80 =cut
  81
  82
  83 my %Config;
  84
  85 our %option_to_number;
  86 our %number_to_option;
  87
  88 BEGIN{
  89
  90     @number_to_option{((0..9),(10..35))} = (('0'..'9'),('A'..'Z'));
  91     %option_to_number = reverse %number_to_option;
  92
  93 }
  94
  95 main();
  96
  97 sub main {
  98     my %options;
  99     GetOptions(\%options,
 100                'option=s@',
 101                'default_option|default-option!',
 102                'quorum=i',
 103               );
 104     if (not exists $options{option} or not ref($options{option}) or
 105         @{$options{option}} < 2
 106        ) {
 107         die "you must give at least two options in a --option argument";
 108     }
 109     my @options;
 110     for my $option (@{$options{option}}) {
 111         my ($key,$name,$majority) = $option =~ /^\s*([^:]+?)\s*:\s*(.+?)\s*(?::(\d+))?$/;
 112         $majority //= 1;
 113         push @options,{key => $key,
 114                        name => $name,
 115                        majority => $majority,
 116                       };
 117     }
 118     winner(options=>\@options,
 119            default_option => exists $options{default_option} ? $options{default_option} : 1,
 120            quorum => exists $options{quorum} ? $options{quorum} : 2,
 121           );
 122 }
 123
 124 sub encode_base64{
 125     return map {$option_to_number{$_}} @_;
 126 }
 127
 128 sub decode_base64{
 129     return map {$number_to_option{$_}} @_;
 130 }
 131
 132 sub winner {
 133   my %params   = validate_with(params => \@_,
 134                                spec   => {quorum => {default => 5,
 135                                                      regex => qr/^\d+$/,
 136                                                     },
 137                                           options => {type => ARRAYREF,
 138                                                      },
 139                                           tally_fh => {type => HANDLE,
 140                                                        optional => 1,
 141                                                       },
 142                                           default_option => {default => 1,
 143                                                              type => BOOLEAN,
 144                                                             },
 145                                          },
 146                                );
 147   # options is an array to keep it ordered
 148   my @options = @{$params{options}};
 149   my %options;
 150   my %order_to_options;
 151   my $max_choices = 0;
 152   my $order=1;
 153   my $valid_options = '';
 154   for my $option (@options) {
 155       $options{$option->{key}} =
 156          {key => $option->{key},
 157           name => $option->{name},
 158           majority => $option->{majority} // 1,
 159           order => $order,
 160          };
 161       $order_to_options{$order} = $options{$option->{key}};
 162       $valid_options .= $option->{key};
 163       $max_choices = $order;
 164       $order++;
 165   }
 166
 167   # The constitution defines the maximum value of K to be 5
 168   my $K = $params{quorum};
 169
 170   #   1. Given two options A and B, V(A,B) is the number of voters who
 171   #      prefer option A over option B.
 172   my @Beat_Matrix = ();
 173   for my $row (0..$max_choices) {
 174     for my $col (0..$max_choices) {
 175       $Beat_Matrix[$row][$col] = 0; #Math::BigFloat->bzero();
 176     }
 177   }
 178
 179   my $RESULTS = \*STDOUT;
 180
 181   my $now_string = gmtime;
 182   print {$RESULTS} "Starting results calculation at $now_string\n\n";
 183
 184   if (not defined $params{tally_fh}) {
 185       $params{tally_fh} = \*STDIN;
 186   }
 187   # header been output?
 188   my $header_output = 0;
 189
 190   # This is where we get our input data from
 191   while (defined ($_ = $params{tally_fh}->getline)) {
 192       chomp;
 193       my $vote;
 194       my $voter;
 195       if (m/^V:\s+(\S+)\s+(\S)/) { # standard devotee syntax
 196           $voter = $2;
 197           $vote = $1;
 198       } elsif (m/^(.+) # the voter, can have spaces
 199                  \s*:\s+ # needs a colon and a space
 200                  ((?:[$valid_options] # the vote
 201                          \s*(?:,|=|>)?\s*)*) # allow > and , or =
 202                  \s*$/x # useless trailing spaces
 203               ) {
 204           $voter = $1;
 205           $vote = $2;
 206           # now, because this format has the options ranked instead of
 207           # the rank of the option, figure out the rank of the option,
 208           # and give that to devotee
 209           my $current_rank = 1;
 210           my %option_rank;
 211           while ($vote =~ /([$valid_options]) # the vote
 212                            \s*((?:,|=|>)?)\s*/xg) {
 213               my ($option,$relationship) = ($1,$2);
 214               $option_rank{$option} = $current_rank;
 215               if ($relationship ne '=') {
 216                   $current_rank++;
 217               }
 218           }
 219           $vote = '';
 220           for my $opt (@options) {
 221               $vote .= exists $option_rank{$opt->{key}} ? $number_to_option{$option_rank{$opt->{key}}} : '-';
 222           }
 223           if (not $header_output) {
 224               print {$RESULTS} "/--".join("",map {$_->{key}} @options)."\n";
 225               $header_output = 1;
 226           }
 227           print {$RESULTS} "V: $vote $voter\n";
 228
 229       } else {
 230          print STDERR "ignoring line '$_'; this is probably wrong!\n";
 231          next;
 232       }
 233
 234       # my @rank = unpack "a" x $max_choices, $vote;
 235       my @rank = ();
 236       foreach my $rank (split //, uc $vote) {
 237           if ($rank eq '-') {
 238               push(@rank,$rank);
 239           }
 240           else {
 241               push(@rank,encode_base64($rank));
 242           }
 243       }
 244       foreach my $i (0..($max_choices - 1)) {
 245           foreach my $j (($i + 1)..($max_choices - 1)) {
 246               if ($rank[$i] eq '-' && $rank[$j] eq '-') {
 247                   next;                 # Both unranked
 248               } elsif ($rank[$i] eq '-' && $rank[$j] ne '-') {
 249                   $Beat_Matrix[$j][$i]++;
 250               } elsif ($rank[$i] ne '-' && $rank[$j] eq '-') {
 251                   $Beat_Matrix[$i][$j]++;
 252               } elsif ($rank[$i] < $rank[$j]) {
 253                   $Beat_Matrix[$i][$j]++;
 254               } elsif ($rank[$i] > $rank[$j]) {
 255                   $Beat_Matrix[$j][$i]++;
 256               } else {
 257                   next;                 # Equally ranked
 258               }
 259           }
 260       }
 261   }
 262   for my $opt (0..($max_choices - 1)) {
 263       print {$RESULTS} "Option ", $order_to_options{$opt+1}{key}, " \"",
 264           $order_to_options{$opt+1}{name},
 265           "\"\n";
 266   }
 267   print {$RESULTS} <<EOF;
 268
 269 In the following table, tally[row x][col y] represents the votes that
 270 option x received over option y.
 271
 272 EOF
 273   ;
 274
 275   print {$RESULTS} " " x18, "Option\n";
 276   print {$RESULTS} " " x10;
 277   for my $col (0..($max_choices - 1)) {
 278       printf {$RESULTS} " % 4s ", $order_to_options{$col + 1}{key};
 279   }
 280
 281   print {$RESULTS} "\n";
 282   print {$RESULTS} " " x10, "  === " x $max_choices, "\n";
 283
 284   for my $row (0..($max_choices - 1)) {
 285       printf {$RESULTS} "Option %s  ", $order_to_options{$row + 1}{key};
 286       for my $col (0..($max_choices - 1)) {
 287           if ($row == $col) {
 288               print {$RESULTS} "      ";
 289           } else {
 290               printf {$RESULTS} " % 4d ", $Beat_Matrix[$row][$col];
 291           }
 292       }
 293       print {$RESULTS} "\n";
 294   }
 295   print {$RESULTS} "\n\n";
 296
 297   print {$RESULTS} <<EOM;
 298
 299 Looking at row 2, column 1, $order_to_options{2}{key}
 300 received $Beat_Matrix[1][0] votes over $order_to_options{1}{key}
 301
 302 Looking at row 1, column 2, $order_to_options{1}{key}
 303 received $Beat_Matrix[0][1] votes over $order_to_options{2}{key}.
 304
 305 EOM
 306   ;
 307
 308   my %Drop = ();
 309
 310   if ($params{default_option}) {
 311       foreach my $i (0..($max_choices - 2)) {
 312           if ($K > $Beat_Matrix[$i][$max_choices - 1]) {
 313               $Drop{$i}++;
 314               print {$RESULTS} "Dropping Option ", $order_to_options{$i + 1}{key},
 315                   " \"", $order_to_options{$i + 1}{name},
 316                   "\" because of Quorum ($K > $Beat_Matrix[$i][$max_choices - 1])\n";
 317           } else {
 318               print {$RESULTS} "Option ", $order_to_options{$i + 1}{key},
 319                   " Reached quorum: $Beat_Matrix[$i][$max_choices - 1] >= $K\n";
 320           }
 321       }
 322       print {$RESULTS} "\n\n";
 323   }
 324
 325   # Record Majority
 326   my %Ratio = ();
 327
 328
 329   #   2. An option A defeats the default option D by a majority ratio N,
 330   #   if V(A,D) is greater or equal to N * V(D,A) and V(A,D) is strictly
 331   #   greater than V(D,A).
 332   #   3. If a supermajority of S:1 is required for A, its majority ratio
 333   #   is S; otherwise, its majority ratio is 1.
 334   #  Any (non-default) option which does not defeat the default option
 335   #  by its required majority ratio is dropped from consideration.
 336   foreach my $i (0..($max_choices - 2)) {
 337       next unless $Beat_Matrix[$max_choices - 1][$i];
 338       next if $Drop{$i};
 339
 340       my $ratio = 1.0 * $Beat_Matrix[$i][$max_choices - 1] /
 341           $Beat_Matrix[$max_choices - 1][$i];
 342       $Ratio{$i} = sprintf("%.2f", $ratio);
 343       if ($ratio < $order_to_options{$i + 1}{majority} or $ratio <= 1) {
 344           # If the next line is commented out, we get a more verbose set of results
 345           $Drop{$i}++;
 346           print {$RESULTS} "Dropping Option ", $order_to_options{$i + 1}{key},
 347               " because of Majority. ($ratio)";
 348           my $comparison_sign = $order_to_options{$i + 1}{majority} == 1 ? '<=' : '<';
 349           printf {$RESULTS} " %6.3f (%d/%d) $comparison_sign %d\n",
 350               $ratio, $Beat_Matrix[$i][$max_choices - 1],
 351               $Beat_Matrix[$max_choices - 1][$i],
 352               $order_to_options{$i + 1}{majority};
 353       } else {
 354           print {$RESULTS} "Option ", $order_to_options{$i + 1}{key}, " passes Majority.";
 355           print {$RESULTS} "             ";
 356           my $comparison_sign = $order_to_options{$i + 1}{majority} == 1 ? '>' : '>=';
 357           printf {$RESULTS} " %6.3f (%d/%d) $comparison_sign %d\n",
 358               $ratio, $Beat_Matrix[$i][$max_choices - 1],
 359               $Beat_Matrix[$max_choices - 1][$i],
 360               $order_to_options{$i + 1}{majority};
 361       }
 362   }
 363   print {$RESULTS} "\n\n";
 364
 365   my $done = 0;
 366   my %Defeats;
 367   # Initialize the Defeats matrix
 368   foreach my $i (0..($max_choices - 1)) {
 369     next if $Drop{$i};
 370     foreach my $j (($i + 1)..($max_choices - 1)) {
 371         next if $Drop{$j};
 372         if ($Beat_Matrix[$i][$j] > $Beat_Matrix[$j][$i]) {
 373             # i defeats j
 374             $Defeats{$i}{$j}{for}     = $Beat_Matrix[$i][$j];
 375             $Defeats{$i}{$j}{against} = $Beat_Matrix[$j][$i];
 376
 377             print {$RESULTS} "  Option ", $order_to_options{$i + 1}{key}, " defeats Option ",
 378                 $order_to_options{$j + 1}{key},
 379                 sprintf(" by (% 4d - % 4d) = %4d votes.\n",
 380                         $Beat_Matrix[$i][$j],  $Beat_Matrix[$j][$i],
 381                         $Beat_Matrix[$i][$j] - $Beat_Matrix[$j][$i]);
 382         } elsif ($Beat_Matrix[$i][$j] < $Beat_Matrix[$j][$i]) {
 383             # j defeats i
 384             $Defeats{$j}{$i}{for}     = $Beat_Matrix[$j][$i];
 385             $Defeats{$j}{$i}{against} = $Beat_Matrix[$i][$j];
 386
 387             print {$RESULTS} "  Option ", $order_to_options{$j + 1}{key}, " defeats Option ",
 388                 $order_to_options{$i + 1}{key},
 389                 sprintf(" by (% 4d - % 4d) = %4d votes.\n",
 390                         $Beat_Matrix[$j][$i],  $Beat_Matrix[$i][$j],
 391                         $Beat_Matrix[$j][$i] - $Beat_Matrix[$i][$j]);
 392         }
 393     }
 394 }
 395   print {$RESULTS} "\n\n";
 396   my %BeatPath;
 397   my @Schwartz;
 398   # Ok, here is what we are here for.
 399   while (1) {
 400
 401     # From the list of [undropped] pairwise defeats, we generate a set of
 402     # transitive defeats.
 403
 404     # Initialize the Beatpath
 405     undef %BeatPath;
 406     foreach my $i (0..($max_choices - 1)) {
 407       next if $Drop{$i};
 408       foreach my $j (0..($max_choices - 1)) {
 409         next if $Drop{$j};
 410         $BeatPath{$i}{$j}{for}     = $Defeats{$i}{$j}{for};
 411         $BeatPath{$i}{$j}{against} = $Defeats{$i}{$j}{against};
 412       }
 413     }
 414
 415     #   1. An option A transitively defeats an option C if A defeats C or
 416     #      if there is some other option B where A defeats B AND B
 417     #      transitively defeats C.
 418     while (!$done) {
 419       $done = 1;
 420       foreach my $i (0..($max_choices - 1)) {
 421         next if $Drop{$i};
 422         foreach my $j (0..($max_choices - 1)) {
 423           next if $Drop{$j};
 424           next if $i == $j;
 425           foreach my $k (0..($max_choices - 1)) {
 426             next if $Drop{$k};
 427             next if $i == $k;
 428             next if $k == $j;
 429             if (!$BeatPath{$i}{$j}{for}) {
 430               if ($BeatPath{$i}{$k}{for} && $BeatPath{$k}{$j}{for} ) {
 431                 if ($BeatPath{$i}{$k}{for} == $BeatPath{$k}{$j}{for}) {
 432                   $BeatPath{$i}{$j}{for} = ($BeatPath{$i}{$k}{against} >
 433                                             $BeatPath{$k}{$j}{against}) ?
 434                                               $BeatPath{$i}{$k}{for}:$BeatPath{$k}{$j}{for};
 435                   $BeatPath{$i}{$j}{against} = ($BeatPath{$i}{$k}{against} >
 436                                                 $BeatPath{$k}{$j}{against}) ?
 437                                                   $BeatPath{$i}{$k}{against} :
 438                                                     $BeatPath{$k}{$j}{against};
 439                 } else {
 440                   $BeatPath{$i}{$j}{for} = ($BeatPath{$i}{$k}{for} <
 441                                             $BeatPath{$k}{$j}{for}) ?
 442                                               $BeatPath{$i}{$k}{for} :
 443                                                 $BeatPath{$k}{$j}{for};
 444                   $BeatPath{$i}{$j}{against} = ($BeatPath{$i}{$k}{for} <
 445                                                 $BeatPath{$k}{$j}{for}) ?
 446                                                   $BeatPath{$i}{$k}{against} :
 447                                                     $BeatPath{$k}{$j}{against};
 448                 }
 449                 $done = 0;
 450               }
 451             }
 452           }
 453         }
 454       }
 455     }
 456
 457
 458     # We construct the Schwartz set from the set of transitive defeats.
 459     foreach my $i (0..($max_choices - 1)) {
 460       if ($Drop{$i}) {
 461         $Schwartz[$i] = 0;
 462       } else {
 463         $Schwartz[$i] = 1;
 464       }
 465     }
 466
 467     foreach my $i (0..($max_choices - 1)) {
 468       foreach my $j (0..($max_choices - 1)) {
 469         next if $i == $j;
 470         # An option A is in the Schwartz set if for all options B, either
 471         # A transitively defeats B, or B does not transitively defeat A
 472         # Here, we throw out any option $i that does not meet the above
 473         # criteria.
 474         if (! ($BeatPath{$i}{$j}{for} || ! $BeatPath{$j}{$i}{for})) {
 475           $Schwartz[$i] = 0;
 476         }
 477       }
 478     }
 479     print {$RESULTS} "The Schwartz Set contains:\n";
 480     foreach my $i (0 ..$#Schwartz) {
 481       next unless $Schwartz[$i];
 482       print {$RESULTS} "\t Option ", $order_to_options{$i + 1}{key}, " \"",
 483         $order_to_options{$i + 1}{name}, "\"\n";
 484     }
 485     print {$RESULTS} "\n\n";
 486
 487     # If there are defeats between options in the Schwartz set, we drop
 488     # the weakest such defeats from the list of pairwise defeats, and
 489     # return to step 5.
 490
 491     #  1. A defeat (A,X) is weaker than a defeat (B,Y) if V(A,X) is
 492     #     less than V(B,Y). Also, (A,X) is weaker than (B,Y) if V(A,X) is
 493     #     equal to V(B,Y) and V(X,A) is greater than V(Y,B).
 494
 495     #  2. A weakest defeat is a defeat that has no other defeat weaker
 496     #  than it. There may be more than one such defeat.
 497
 498     # Check to see if there is anything in the Schwartz set that has no
 499     # defeats.
 500     my %Weakest;
 501     my $weak_count = 0;
 502     foreach my $i (0 ..$#Schwartz) {
 503       next unless $Schwartz[$i];
 504       foreach my $j (0..$#Schwartz) {
 505         next unless $Schwartz[$j];
 506         next if $i == $j;
 507         if (defined $Defeats{$i}{$j}{'for'}) {
 508           if (! $weak_count) {
 509             $Weakest{$weak_count}{'for'}     = $Defeats{$i}{$j}{for};
 510             $Weakest{$weak_count}{'against'} = $Defeats{$i}{$j}{against};
 511             $Weakest{$weak_count}{'Winner'}  = $i;
 512             $Weakest{$weak_count}{'Loser'}   = $j;
 513             $weak_count++;
 514           } elsif ($Weakest{0}{'for'} > $Defeats{$i}{$j}{for}) {
 515             undef %Weakest;
 516             $weak_count = 0;
 517             $Weakest{$weak_count}{'for'}     = $Defeats{$i}{$j}{for};
 518             $Weakest{$weak_count}{'against'} = $Defeats{$i}{$j}{against};
 519             $Weakest{$weak_count}{'Winner'}  = $i;
 520             $Weakest{$weak_count}{'Loser'}   = $j;
 521             $weak_count++;
 522           } elsif ($Weakest{0}{'for'} == $Defeats{$i}{$j}{'for'}) {
 523             if ($Weakest{0}{'against'} < $Defeats{$i}{$j}{against}) {
 524               undef %Weakest;
 525               $weak_count = 0;
 526               $Weakest{$weak_count}{'for'}     = $Defeats{$i}{$j}{for};
 527               $Weakest{$weak_count}{'against'} = $Defeats{$i}{$j}{against};
 528               $Weakest{$weak_count}{'Winner'}  = $i;
 529               $Weakest{$weak_count}{'Loser'}   = $j;
 530               $weak_count++;
 531             } else {
 532               $Weakest{$weak_count}{'for'}     = $Defeats{$i}{$j}{'for'};
 533               $Weakest{$weak_count}{'against'} = $Defeats{$i}{$j}{'against'};
 534               $Weakest{$weak_count}{'Winner'}  = $i;
 535               $Weakest{$weak_count}{'Loser'}   = $j;
 536               $weak_count++;
 537             }
 538           }
 539         }
 540         if (defined $Defeats{$j}{$i}{'for'}) {
 541           if (! $weak_count) {
 542             $Weakest{$weak_count}{'for'}     = $Defeats{$j}{$i}{'for'};
 543             $Weakest{$weak_count}{'against'} = $Defeats{$j}{$i}{'against'};
 544             $Weakest{$weak_count}{'Winner'}  = $j;
 545             $Weakest{$weak_count}{'Loser'}   = $i;
 546             $weak_count++;
 547           } elsif ($Weakest{0}{'for'} > $Defeats{$j}{$i}{'for'}) {
 548             undef %Weakest;
 549             $weak_count = 0;
 550             $Weakest{$weak_count}{'for'}     = $Defeats{$j}{$i}{'for'};
 551             $Weakest{$weak_count}{'against'} = $Defeats{$j}{$i}{'against'};
 552             $Weakest{$weak_count}{'Winner'}  = $j;
 553             $Weakest{$weak_count}{'Loser'}   = $i;
 554             $weak_count++;
 555           } elsif ($Weakest{0}{'Low'} == $Defeats{$j}{$i}{'for'}) {
 556             if ($Weakest{0}{'against'} < $Defeats{$j}{$i}{'against'}) {
 557               undef %Weakest;
 558               $weak_count = 0;
 559               $Weakest{$weak_count}{'for'}    = $Defeats{$j}{$i}{'for'};
 560               $Weakest{$weak_count}{'against'} = $Defeats{$j}{$i}{'against'};
 561               $Weakest{$weak_count}{'Winner'} = $j;
 562               $Weakest{$weak_count}{'Loser'}  = $i;
 563               $weak_count++;
 564             } else {
 565               $Weakest{$weak_count}{'for'}     = $Defeats{$j}{$i}{'for'};
 566               $Weakest{$weak_count}{'against'} = $Defeats{$j}{$i}{'against'};
 567               $Weakest{$weak_count}{'Winner'}  = $j;
 568               $Weakest{$weak_count}{'Loser'}   = $i;
 569               $weak_count++;
 570             }
 571           }
 572         }
 573       }
 574     }
 575     if (! $weak_count) {
 576       print {$RESULTS} "\n", "-=" x 35, "\n";
 577       print {$RESULTS} "-=" x 35, "\n\n";
 578       print {$RESULTS} "The winners are:\n";
 579       foreach my $i (0 ..$#Schwartz) {
 580         next unless $Schwartz[$i];
 581         print {$RESULTS} "\t Option ", $order_to_options{$i + 1}{key}, " \"",
 582           $order_to_options{$i + 1}{name}, "\"\n";
 583       }
 584       print {$RESULTS} "\n", "-=" x 35, "\n";
 585       print {$RESULTS} "-=" x 35, "\n\n";
 586       last;
 587     } else {
 588       print {$RESULTS} "Weakest Defeat(s): \n";
 589       foreach my $k (sort keys %Weakest) {
 590         print {$RESULTS} "\tOption ", $order_to_options{$Weakest{$k}{'Winner'} + 1}{key},
 591           " beats Option ", $order_to_options{$Weakest{$k}{'Loser'} + 1}{key}, " by ",
 592             " ($Beat_Matrix[$Weakest{$k}{'Winner'}][$Weakest{$k}{'Loser'}] - ",
 593               "$Beat_Matrix[$Weakest{$k}{'Loser'}][$Weakest{$k}{'Winner'}])\t",
 594                 "= ", $Weakest{$k}{'for'} - $Weakest{$k}{'against'}, " votes\n";
 595       }
 596       print {$RESULTS} "Deleting weakest defeat(s)\n\n";
 597       foreach my $k (sort keys %Weakest) {
 598         delete $Defeats{$Weakest{$k}{'Winner'}}{$Weakest{$k}{'Loser'}};
 599       }
 600   }
 601 }
 602 }
 603
 604
 605
 606
 607
 608 exit 0;
 609
 610
 611 =head1 CAVEATS
 612
 613 This is very inchoate, at the moment, and needs testing.
 614
 615 =cut
 616
 617 =head1 BUGS
 618
 619 None Known so far.
 620
 621 =cut
 622
 623 =head1 AUTHOR
 624
 625 Manoj Srivastava <srivasta@debian.org>
 626
 627 =head1 COPYRIGHT AND LICENSE
 628
 629 This script is a part of the Devotee package, and is
 630
 631 Copyright (c) 2002, 2003, 2004, 2005  Manoj Srivastava <srivasta@debian.org>
 632
 633 This program is free software; you can redistribute it and/or modify
 634 it under the terms of the GNU General Public License as published by
 635 the Free Software Foundation; either version 2 of the License, or
 636 (at your option) any later version.
 637
 638 This program is distributed in the hope that it will be useful,
 639 but WITHOUT ANY WARRANTY; without even the implied warranty of
 640 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 641 GNU General Public License for more details.
 642
 643 You should have received a copy of the GNU General Public License
 644 along with this program; if not, write to the Free Software
 645 Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 646
 647 =cut
 648
 649
 650
 651 __END__
 652