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 strictly greater than N * V(D,A).
 331   #   3. If a supermajority of S:1 is required for A, its majority ratio
 332   #   is S; otherwise, its majority ratio is 1.
 333   #  Any (non-default) option which does not defeat the default option
 334   #  by its required majority ratio is dropped from consideration.
 335   foreach my $i (0..($max_choices - 2)) {
 336       next unless $Beat_Matrix[$max_choices - 1][$i];
 337       next if $Drop{$i};
 338
 339       my $ratio = 1.0 * $Beat_Matrix[$i][$max_choices - 1] /
 340           $Beat_Matrix[$max_choices - 1][$i];
 341       $Ratio{$i} = sprintf("%.2f", $ratio);
 342       if ($ratio < $order_to_options{$i + 1}{majority}) {
 343           # If the next line is commented out, we get a more verbose set of results
 344           $Drop{$i}++;
 345           print {$RESULTS} "Dropping Option ", $order_to_options{$i + 1}{key},
 346               " because of Majority. ($ratio)";
 347           printf {$RESULTS} " %6.3f (%d/%d) < %d\n",
 348               $ratio, $Beat_Matrix[$i][$max_choices - 1],
 349               $Beat_Matrix[$max_choices - 1][$i],
 350               $order_to_options{$i + 1}{majority};
 351       } else {
 352           print {$RESULTS} "Option ", $order_to_options{$i + 1}{key}, " passes Majority.";
 353           print {$RESULTS} "             ";
 354           printf {$RESULTS} " %6.3f (%d/%d) >= %d\n",
 355               $ratio, $Beat_Matrix[$i][$max_choices - 1],
 356               $Beat_Matrix[$max_choices - 1][$i],
 357               $order_to_options{$i + 1}{majority};
 358       }
 359   }
 360   print {$RESULTS} "\n\n";
 361
 362   my $done = 0;
 363   my %Defeats;
 364   # Initialize the Defeats matrix
 365   foreach my $i (0..($max_choices - 1)) {
 366     next if $Drop{$i};
 367     foreach my $j (($i + 1)..($max_choices - 1)) {
 368         next if $Drop{$j};
 369         if ($Beat_Matrix[$i][$j] > $Beat_Matrix[$j][$i]) {
 370             # i defeats j
 371             $Defeats{$i}{$j}{for}     = $Beat_Matrix[$i][$j];
 372             $Defeats{$i}{$j}{against} = $Beat_Matrix[$j][$i];
 373
 374             print {$RESULTS} "  Option ", $order_to_options{$i + 1}{key}, " defeats Option ",
 375                 $order_to_options{$j + 1}{key},
 376                 sprintf(" by (% 4d - % 4d) = %4d votes.\n",
 377                         $Beat_Matrix[$i][$j],  $Beat_Matrix[$j][$i],
 378                         $Beat_Matrix[$i][$j] - $Beat_Matrix[$j][$i]);
 379         } elsif ($Beat_Matrix[$i][$j] < $Beat_Matrix[$j][$i]) {
 380             # j defeats i
 381             $Defeats{$j}{$i}{for}     = $Beat_Matrix[$j][$i];
 382             $Defeats{$j}{$i}{against} = $Beat_Matrix[$i][$j];
 383
 384             print {$RESULTS} "  Option ", $order_to_options{$j + 1}{key}, " defeats Option ",
 385                 $order_to_options{$i + 1}{key},
 386                 sprintf(" by (% 4d - % 4d) = %4d votes.\n",
 387                         $Beat_Matrix[$j][$i],  $Beat_Matrix[$i][$j],
 388                         $Beat_Matrix[$j][$i] - $Beat_Matrix[$i][$j]);
 389         }
 390     }
 391 }
 392   print {$RESULTS} "\n\n";
 393   my %BeatPath;
 394   my @Schwartz;
 395   # Ok, here is what we are here for.
 396   while (1) {
 397
 398     # From the list of [undropped] pairwise defeats, we generate a set of
 399     # transitive defeats.
 400
 401     # Initialize the Beatpath
 402     undef %BeatPath;
 403     foreach my $i (0..($max_choices - 1)) {
 404       next if $Drop{$i};
 405       foreach my $j (0..($max_choices - 1)) {
 406         next if $Drop{$j};
 407         $BeatPath{$i}{$j}{for}     = $Defeats{$i}{$j}{for};
 408         $BeatPath{$i}{$j}{against} = $Defeats{$i}{$j}{against};
 409       }
 410     }
 411
 412     #   1. An option A transitively defeats an option C if A defeats C or
 413     #      if there is some other option B where A defeats B AND B
 414     #      transitively defeats C.
 415     while (!$done) {
 416       $done = 1;
 417       foreach my $i (0..($max_choices - 1)) {
 418         next if $Drop{$i};
 419         foreach my $j (0..($max_choices - 1)) {
 420           next if $Drop{$j};
 421           next if $i == $j;
 422           foreach my $k (0..($max_choices - 1)) {
 423             next if $Drop{$k};
 424             next if $i == $k;
 425             next if $k == $j;
 426             if (!$BeatPath{$i}{$j}{for}) {
 427               if ($BeatPath{$i}{$k}{for} && $BeatPath{$k}{$j}{for} ) {
 428                 if ($BeatPath{$i}{$k}{for} == $BeatPath{$k}{$j}{for}) {
 429                   $BeatPath{$i}{$j}{for} = ($BeatPath{$i}{$k}{against} >
 430                                             $BeatPath{$k}{$j}{against}) ?
 431                                               $BeatPath{$i}{$k}{for}:$BeatPath{$k}{$j}{for};
 432                   $BeatPath{$i}{$j}{against} = ($BeatPath{$i}{$k}{against} >
 433                                                 $BeatPath{$k}{$j}{against}) ?
 434                                                   $BeatPath{$i}{$k}{against} :
 435                                                     $BeatPath{$k}{$j}{against};
 436                 } else {
 437                   $BeatPath{$i}{$j}{for} = ($BeatPath{$i}{$k}{for} <
 438                                             $BeatPath{$k}{$j}{for}) ?
 439                                               $BeatPath{$i}{$k}{for} :
 440                                                 $BeatPath{$k}{$j}{for};
 441                   $BeatPath{$i}{$j}{against} = ($BeatPath{$i}{$k}{for} <
 442                                                 $BeatPath{$k}{$j}{for}) ?
 443                                                   $BeatPath{$i}{$k}{against} :
 444                                                     $BeatPath{$k}{$j}{against};
 445                 }
 446                 $done = 0;
 447               }
 448             }
 449           }
 450         }
 451       }
 452     }
 453
 454
 455     # We construct the Schwartz set from the set of transitive defeats.
 456     foreach my $i (0..($max_choices - 1)) {
 457       if ($Drop{$i}) {
 458         $Schwartz[$i] = 0;
 459       } else {
 460         $Schwartz[$i] = 1;
 461       }
 462     }
 463
 464     foreach my $i (0..($max_choices - 1)) {
 465       foreach my $j (0..($max_choices - 1)) {
 466         next if $i == $j;
 467         # An option A is in the Schwartz set if for all options B, either
 468         # A transitively defeats B, or B does not transitively defeat A
 469         # Here, we throw out any option $i that does not meet the above
 470         # criteria.
 471         if (! ($BeatPath{$i}{$j}{for} || ! $BeatPath{$j}{$i}{for})) {
 472           $Schwartz[$i] = 0;
 473         }
 474       }
 475     }
 476     print {$RESULTS} "The Schwartz Set contains:\n";
 477     foreach my $i (0 ..$#Schwartz) {
 478       next unless $Schwartz[$i];
 479       print {$RESULTS} "\t Option ", $order_to_options{$i + 1}{key}, " \"",
 480         $order_to_options{$i + 1}{name}, "\"\n";
 481     }
 482     print {$RESULTS} "\n\n";
 483
 484     # If there are defeats between options in the Schwartz set, we drop
 485     # the weakest such defeats from the list of pairwise defeats, and
 486     # return to step 5.
 487
 488     #  1. A defeat (A,X) is weaker than a defeat (B,Y) if V(A,X) is
 489     #     less than V(B,Y). Also, (A,X) is weaker than (B,Y) if V(A,X) is
 490     #     equal to V(B,Y) and V(X,A) is greater than V(Y,B).
 491
 492     #  2. A weakest defeat is a defeat that has no other defeat weaker
 493     #  than it. There may be more than one such defeat.
 494
 495     # Check to see if there is anything in the Schwartz set that has no
 496     # defeats.
 497     my %Weakest;
 498     my $weak_count = 0;
 499     foreach my $i (0 ..$#Schwartz) {
 500       next unless $Schwartz[$i];
 501       foreach my $j (0..$#Schwartz) {
 502         next unless $Schwartz[$j];
 503         next if $i == $j;
 504         if (defined $Defeats{$i}{$j}{'for'}) {
 505           if (! $weak_count) {
 506             $Weakest{$weak_count}{'for'}     = $Defeats{$i}{$j}{for};
 507             $Weakest{$weak_count}{'against'} = $Defeats{$i}{$j}{against};
 508             $Weakest{$weak_count}{'Winner'}  = $i;
 509             $Weakest{$weak_count}{'Loser'}   = $j;
 510             $weak_count++;
 511           } elsif ($Weakest{0}{'for'} > $Defeats{$i}{$j}{for}) {
 512             undef %Weakest;
 513             $weak_count = 0;
 514             $Weakest{$weak_count}{'for'}     = $Defeats{$i}{$j}{for};
 515             $Weakest{$weak_count}{'against'} = $Defeats{$i}{$j}{against};
 516             $Weakest{$weak_count}{'Winner'}  = $i;
 517             $Weakest{$weak_count}{'Loser'}   = $j;
 518             $weak_count++;
 519           } elsif ($Weakest{0}{'for'} == $Defeats{$i}{$j}{'for'}) {
 520             if ($Weakest{0}{'against'} < $Defeats{$i}{$j}{against}) {
 521               undef %Weakest;
 522               $weak_count = 0;
 523               $Weakest{$weak_count}{'for'}     = $Defeats{$i}{$j}{for};
 524               $Weakest{$weak_count}{'against'} = $Defeats{$i}{$j}{against};
 525               $Weakest{$weak_count}{'Winner'}  = $i;
 526               $Weakest{$weak_count}{'Loser'}   = $j;
 527               $weak_count++;
 528             } else {
 529               $Weakest{$weak_count}{'for'}     = $Defeats{$i}{$j}{'for'};
 530               $Weakest{$weak_count}{'against'} = $Defeats{$i}{$j}{'against'};
 531               $Weakest{$weak_count}{'Winner'}  = $i;
 532               $Weakest{$weak_count}{'Loser'}   = $j;
 533               $weak_count++;
 534             }
 535           }
 536         }
 537         if (defined $Defeats{$j}{$i}{'for'}) {
 538           if (! $weak_count) {
 539             $Weakest{$weak_count}{'for'}     = $Defeats{$j}{$i}{'for'};
 540             $Weakest{$weak_count}{'against'} = $Defeats{$j}{$i}{'against'};
 541             $Weakest{$weak_count}{'Winner'}  = $j;
 542             $Weakest{$weak_count}{'Loser'}   = $i;
 543             $weak_count++;
 544           } elsif ($Weakest{0}{'for'} > $Defeats{$j}{$i}{'for'}) {
 545             undef %Weakest;
 546             $weak_count = 0;
 547             $Weakest{$weak_count}{'for'}     = $Defeats{$j}{$i}{'for'};
 548             $Weakest{$weak_count}{'against'} = $Defeats{$j}{$i}{'against'};
 549             $Weakest{$weak_count}{'Winner'}  = $j;
 550             $Weakest{$weak_count}{'Loser'}   = $i;
 551             $weak_count++;
 552           } elsif ($Weakest{0}{'Low'} == $Defeats{$j}{$i}{'for'}) {
 553             if ($Weakest{0}{'against'} < $Defeats{$j}{$i}{'against'}) {
 554               undef %Weakest;
 555               $weak_count = 0;
 556               $Weakest{$weak_count}{'for'}    = $Defeats{$j}{$i}{'for'};
 557               $Weakest{$weak_count}{'against'} = $Defeats{$j}{$i}{'against'};
 558               $Weakest{$weak_count}{'Winner'} = $j;
 559               $Weakest{$weak_count}{'Loser'}  = $i;
 560               $weak_count++;
 561             } else {
 562               $Weakest{$weak_count}{'for'}     = $Defeats{$j}{$i}{'for'};
 563               $Weakest{$weak_count}{'against'} = $Defeats{$j}{$i}{'against'};
 564               $Weakest{$weak_count}{'Winner'}  = $j;
 565               $Weakest{$weak_count}{'Loser'}   = $i;
 566               $weak_count++;
 567             }
 568           }
 569         }
 570       }
 571     }
 572     if (! $weak_count) {
 573       print {$RESULTS} "\n", "-=" x 35, "\n";
 574       print {$RESULTS} "-=" x 35, "\n\n";
 575       print {$RESULTS} "The winners are:\n";
 576       foreach my $i (0 ..$#Schwartz) {
 577         next unless $Schwartz[$i];
 578         print {$RESULTS} "\t Option ", $order_to_options{$i + 1}{key}, " \"",
 579           $order_to_options{$i + 1}{name}, "\"\n";
 580       }
 581       print {$RESULTS} "\n", "-=" x 35, "\n";
 582       print {$RESULTS} "-=" x 35, "\n\n";
 583       last;
 584     } else {
 585       print {$RESULTS} "Weakest Defeat(s): \n";
 586       foreach my $k (sort keys %Weakest) {
 587         print {$RESULTS} "\tOption ", $order_to_options{$Weakest{$k}{'Winner'} + 1}{key},
 588           " beats Option ", $order_to_options{$Weakest{$k}{'Loser'} + 1}{key}, " by ",
 589             " ($Beat_Matrix[$Weakest{$k}{'Winner'}][$Weakest{$k}{'Loser'}] - ",
 590               "$Beat_Matrix[$Weakest{$k}{'Loser'}][$Weakest{$k}{'Winner'}])\t",
 591                 "= ", $Weakest{$k}{'for'} - $Weakest{$k}{'against'}, " votes\n";
 592       }
 593       print {$RESULTS} "Deleting weakest defeat(s)\n\n";
 594       foreach my $k (sort keys %Weakest) {
 595         delete $Defeats{$Weakest{$k}{'Winner'}}{$Weakest{$k}{'Loser'}};
 596       }
 597   }
 598 }
 599 }
 600
 601
 602
 603
 604
 605 exit 0;
 606
 607
 608 =head1 CAVEATS
 609
 610 This is very inchoate, at the moment, and needs testing.
 611
 612 =cut
 613
 614 =head1 BUGS
 615
 616 None Known so far.
 617
 618 =cut
 619
 620 =head1 AUTHOR
 621
 622 Manoj Srivastava <srivasta@debian.org>
 623
 624 =head1 COPYRIGHT AND LICENSE
 625
 626 This script is a part of the Devotee package, and is
 627
 628 Copyright (c) 2002, 2003, 2004, 2005  Manoj Srivastava <srivasta@debian.org>
 629
 630 This program is free software; you can redistribute it and/or modify
 631 it under the terms of the GNU General Public License as published by
 632 the Free Software Foundation; either version 2 of the License, or
 633 (at your option) any later version.
 634
 635 This program is distributed in the hope that it will be useful,
 636 but WITHOUT ANY WARRANTY; without even the implied warranty of
 637 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 638 GNU General Public License for more details.
 639
 640 You should have received a copy of the GNU General Public License
 641 along with this program; if not, write to the Free Software
 642 Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 643
 644 =cut
 645
 646
 647
 648 __END__
 649