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               );
 103     if (not exists $options{option} or not ref($options{option}) or
 104         @{$options{option}} < 2
 105        ) {
 106         die "you must give at least two options in a --option argument";
 107     }
 108     my @options;
 109     for my $option (@{$options{option}}) {
 110         my ($key,$name,$majority) = split /:/,$option;
 111         $majority //= 1;
 112         push @options,{key => $key,
 113                        name => $name,
 114                        majority => $majority,
 115                       };
 116     }
 117     winner(options=>\@options,
 118            default_option => exists $options{default_option} ? $options{default_option} : 1,
 119           );
 120 }
 121
 122 sub encode_base64{
 123     return map {$option_to_number{$_}} @_;
 124 }
 125
 126 sub decode_base64{
 127     return map {$number_to_option{$_}} @_;
 128 }
 129
 130 sub winner {
 131   my %params   = validate_with(params => \@_,
 132                                spec   => {quorum => {default => 5,
 133                                                      regex => qr/^\d+$/,
 134                                                     },
 135                                           options => {type => ARRAYREF,
 136                                                      },
 137                                           tally_fh => {type => HANDLE,
 138                                                        optional => 1,
 139                                                       },
 140                                           default_option => {default => 1,
 141                                                              type => BOOLEAN,
 142                                                             },
 143                                          },
 144                                );
 145   # options is an array to keep it ordered
 146   my @options = @{$params{options}};
 147   my %options;
 148   my %order_to_options;
 149   my $max_choices = 0;
 150   my $order=1;
 151   my $valid_options = '';
 152   for my $option (@options) {
 153       $options{$option->{key}} =
 154          {key => $option->{key},
 155           name => $option->{name},
 156           majority => $option->{majority} // 1,
 157           order => $order,
 158          };
 159       $order_to_options{$order} = $options{$option->{key}};
 160       $valid_options .= $option->{key};
 161       $max_choices = $order;
 162       $order++;
 163   }
 164
 165   # The constitution defines the maximum value of K to be 5
 166   my $K = 2; # Math::BigFloat->new($params{quorum});
 167
 168   #   1. Given two options A and B, V(A,B) is the number of voters who
 169   #      prefer option A over option B.
 170   my @Beat_Matrix = ();
 171   for my $row (0..$max_choices) {
 172     for my $col (0..$max_choices) {
 173       $Beat_Matrix[$row][$col] = 0; #Math::BigFloat->bzero();
 174     }
 175   }
 176
 177   my $RESULTS = \*STDOUT;
 178
 179   my $now_string = gmtime;
 180   print {$RESULTS} "Starting results calculation at $now_string\n\n";
 181
 182   if (not defined $params{tally_fh}) {
 183       $params{tally_fh} = \*STDIN;
 184   }
 185
 186   # This is where we get our input data from
 187   while (defined ($_ = $params{tally_fh}->getline)) {
 188       chomp;
 189       my $vote;
 190       my $voter;
 191       if (m/^V:\s+(\S+)\s+(\S)/) { # standard devotee syntax
 192           $voter = $2;
 193           $vote = $1;
 194       } elsif (m/^(.+) # the voter, can have spaces
 195                  \s*:\s+ # needs a colon and a space
 196                  ((?:[$valid_options] # the vote
 197                          \s*(?:,|=|>)?\s*)*) # allow > and , or =
 198                  \s*$/x # useless trailing spaces
 199               ) {
 200           $voter = $1;
 201           $vote = $2;
 202           # now, because this format has the options ranked instead of
 203           # the rank of the option, figure out the rank of the option,
 204           # and give that to devotee
 205           my $current_rank = 1;
 206           my %option_rank;
 207           while ($vote =~ /([$valid_options]) # the vote
 208                            \s*((?:,|=|>)?)\s*/xg) {
 209               my ($option,$relationship) = ($1,$2);
 210               $option_rank{$option} = $current_rank;
 211               if ($relationship ne '=') {
 212                   $current_rank++;
 213               }
 214           }
 215           $vote = '';
 216           for my $opt (@options) {
 217               $vote .= exists $option_rank{$opt->{key}} ? $option_rank{$opt->{key}} : '-';
 218           }
 219           print {$RESULTS} "V: $vote $voter\n";
 220
 221       } else {
 222          print STDERR "ignoring line '$_'; this is probably wrong!\n";
 223          next;
 224       }
 225
 226       # my @rank = unpack "a" x $max_choices, $vote;
 227       my @rank = ();
 228       foreach my $rank (split //, uc $vote) {
 229           if ($rank eq '-') {
 230               push(@rank,$rank);
 231           }
 232           else {
 233               push(@rank,encode_base64($rank));
 234           }
 235       }
 236       foreach my $i (0..($max_choices - 1)) {
 237           foreach my $j (($i + 1)..($max_choices - 1)) {
 238               if ($rank[$i] eq '-' && $rank[$j] eq '-') {
 239                   next;                 # Both unranked
 240               } elsif ($rank[$i] eq '-' && $rank[$j] ne '-') {
 241                   $Beat_Matrix[$j][$i]++;
 242               } elsif ($rank[$i] ne '-' && $rank[$j] eq '-') {
 243                   $Beat_Matrix[$i][$j]++;
 244               } elsif ($rank[$i] < $rank[$j]) {
 245                   $Beat_Matrix[$i][$j]++;
 246               } elsif ($rank[$i] > $rank[$j]) {
 247                   $Beat_Matrix[$j][$i]++;
 248               } else {
 249                   next;                 # Equally ranked
 250               }
 251           }
 252       }
 253   }
 254   for my $opt (0..($max_choices - 1)) {
 255       print {$RESULTS} "Option ", $order_to_options{$opt+1}{key}, " \"",
 256           $order_to_options{$opt+1}{name},
 257           "\"\n";
 258   }
 259   print {$RESULTS} <<EOF;
 260
 261 In the following table, tally[row x][col y] represents the votes that
 262 option x received over option y.
 263
 264 EOF
 265   ;
 266
 267   print {$RESULTS} " " x18, "Option\n";
 268   print {$RESULTS} " " x10;
 269   for my $col (0..($max_choices - 1)) {
 270       printf {$RESULTS} " % 4s ", $order_to_options{$col + 1}{key};
 271   }
 272
 273   print {$RESULTS} "\n";
 274   print {$RESULTS} " " x10, "  === " x $max_choices, "\n";
 275
 276   for my $row (0..($max_choices - 1)) {
 277       printf {$RESULTS} "Option %s  ", $order_to_options{$row + 1}{key};
 278       for my $col (0..($max_choices - 1)) {
 279           if ($row == $col) {
 280               printf {$RESULTS} "      ", $Beat_Matrix[$row][$col];
 281           } else {
 282               printf {$RESULTS} " % 4d ", $Beat_Matrix[$row][$col];
 283           }
 284       }
 285       print {$RESULTS} "\n";
 286   }
 287   print {$RESULTS} "\n\n";
 288
 289   print {$RESULTS} <<EOM;
 290
 291 Looking at row 2, column 1, $order_to_options{2}{key}
 292 received $Beat_Matrix[1][0] votes over $order_to_options{1}{key}
 293
 294 Looking at row 1, column 2, $order_to_options{1}{key}
 295 received $Beat_Matrix[0][1] votes over $order_to_options{2}{key}.
 296
 297 EOM
 298   ;
 299
 300   my %Drop = ();
 301
 302   if ($params{default_option}) {
 303       foreach my $i (0..($max_choices - 2)) {
 304           if ($K > $Beat_Matrix[$i][$max_choices - 1]) {
 305               $Drop{$i}++;
 306               print {$RESULTS} "Dropping Option", $order_to_options{$i + 1}{key},
 307                   " \"", $order_to_options{$i + 1}{name},
 308                   "\" because of Quorum\n";
 309           } else {
 310               print {$RESULTS} "Option ", $order_to_options{$i + 1}{key},
 311                   " Reached quorum: $Beat_Matrix[$i][$max_choices - 1] > $K\n";
 312           }
 313       }
 314       print {$RESULTS} "\n\n";
 315   }
 316
 317   # Record Majority
 318   my %Ratio = ();
 319
 320
 321   #   2. An option A defeats the default option D by a majority ratio N,
 322   #   if V(A,D) is strictly greater than N * V(D,A).
 323   #   3. If a supermajority of S:1 is required for A, its majority ratio
 324   #   is S; otherwise, its majority ratio is 1.
 325   #  Any (non-default) option which does not defeat the default option
 326   #  by its required majority ratio is dropped from consideration.
 327   foreach my $i (0..($max_choices - 2)) {
 328       next unless $Beat_Matrix[$max_choices - 1][$i];
 329       next if $Drop{$i};
 330
 331       my $ratio = 1.0 * $Beat_Matrix[$i][$max_choices - 1] /
 332           $Beat_Matrix[$max_choices - 1][$i];
 333       $Ratio{$i} = sprintf("%.2f", $ratio);
 334       if ($ratio < $order_to_options{$i + 1}{majority}) {
 335           # If the next line is commented out, we get a more verbose set of results
 336           $Drop{$i}++;
 337           print {$RESULTS} "Dropping Option ", $order_to_options{$i + 1}{key},
 338               " because of Majority. ($ratio)";
 339           printf {$RESULTS} " %6.3f (%d/%d) < %d\n",
 340               $ratio, $Beat_Matrix[$i][$max_choices - 1],
 341               $Beat_Matrix[$max_choices - 1][$i],
 342               $order_to_options{$i + 1}{majority};
 343       } else {
 344           print {$RESULTS} "Option ", $order_to_options{$i + 1}{key}, " passes Majority.";
 345           print {$RESULTS} "             ";
 346           printf {$RESULTS} " %6.3f (%d/%d) >= %d\n",
 347               $ratio, $Beat_Matrix[$i][$max_choices - 1],
 348               $Beat_Matrix[$max_choices - 1][$i],
 349               $order_to_options{$i + 1}{majority};
 350       }
 351   }
 352   print {$RESULTS} "\n\n";
 353
 354   my $done = 0;
 355   my %Defeats;
 356   # Initialize the Defeats matrix
 357   foreach my $i (0..($max_choices - 1)) {
 358     next if $Drop{$i};
 359     foreach my $j (($i + 1)..($max_choices - 1)) {
 360         next if $Drop{$j};
 361         if ($Beat_Matrix[$i][$j] > $Beat_Matrix[$j][$i]) {
 362             # i defeats j
 363             $Defeats{$i}{$j}{for}     = $Beat_Matrix[$i][$j];
 364             $Defeats{$i}{$j}{against} = $Beat_Matrix[$j][$i];
 365
 366             print {$RESULTS} "  Option ", $order_to_options{$i + 1}{key}, " defeats Option ",
 367                 $order_to_options{$j + 1}{key},
 368                 sprintf(" by (% 4d - % 4d) = %4d votes.\n",
 369                         $Beat_Matrix[$i][$j],  $Beat_Matrix[$j][$i],
 370                         $Beat_Matrix[$i][$j] - $Beat_Matrix[$j][$i]);
 371         } elsif ($Beat_Matrix[$i][$j] < $Beat_Matrix[$j][$i]) {
 372             # j defeats i
 373             $Defeats{$j}{$i}{for}     = $Beat_Matrix[$j][$i];
 374             $Defeats{$j}{$i}{against} = $Beat_Matrix[$i][$j];
 375
 376             print {$RESULTS} "  Option ", $order_to_options{$j + 1}{key}, " defeats Option ",
 377                 $order_to_options{$i + 1}{key},
 378                 sprintf(" by (% 4d - % 4d) = %4d votes.\n",
 379                         $Beat_Matrix[$j][$i],  $Beat_Matrix[$i][$j],
 380                         $Beat_Matrix[$j][$i] - $Beat_Matrix[$i][$j]);
 381         }
 382     }
 383 }
 384   print {$RESULTS} "\n\n";
 385   my %BeatPath;
 386   my @Schwartz;
 387   # Ok, here is what we are here for.
 388   while (1) {
 389
 390     # From the list of [undropped] pairwise defeats, we generate a set of
 391     # transitive defeats.
 392
 393     # Initialize the Beatpath
 394     undef %BeatPath;
 395     foreach my $i (0..($max_choices - 1)) {
 396       next if $Drop{$i};
 397       foreach my $j (0..($max_choices - 1)) {
 398         next if $Drop{$j};
 399         $BeatPath{$i}{$j}{for}     = $Defeats{$i}{$j}{for};
 400         $BeatPath{$i}{$j}{against} = $Defeats{$i}{$j}{against};
 401       }
 402     }
 403
 404     #   1. An option A transitively defeats an option C if A defeats C or
 405     #      if there is some other option B where A defeats B AND B
 406     #      transitively defeats C.
 407     while (!$done) {
 408       $done = 1;
 409       foreach my $i (0..($max_choices - 1)) {
 410         next if $Drop{$i};
 411         foreach my $j (0..($max_choices - 1)) {
 412           next if $Drop{$j};
 413           next if $i == $j;
 414           foreach my $k (0..($max_choices - 1)) {
 415             next if $Drop{$k};
 416             next if $i == $k;
 417             next if $k == $j;
 418             if (!$BeatPath{$i}{$j}{for}) {
 419               if ($BeatPath{$i}{$k}{for} && $BeatPath{$k}{$j}{for} ) {
 420                 if ($BeatPath{$i}{$k}{for} == $BeatPath{$k}{$j}{for}) {
 421                   $BeatPath{$i}{$j}{for} = ($BeatPath{$i}{$k}{against} >
 422                                             $BeatPath{$k}{$j}{against}) ?
 423                                               $BeatPath{$i}{$k}{for}:$BeatPath{$k}{$j}{for};
 424                   $BeatPath{$i}{$j}{against} = ($BeatPath{$i}{$k}{against} >
 425                                                 $BeatPath{$k}{$j}{against}) ?
 426                                                   $BeatPath{$i}{$k}{against} :
 427                                                     $BeatPath{$k}{$j}{against};
 428                 } else {
 429                   $BeatPath{$i}{$j}{for} = ($BeatPath{$i}{$k}{for} <
 430                                             $BeatPath{$k}{$j}{for}) ?
 431                                               $BeatPath{$i}{$k}{for} :
 432                                                 $BeatPath{$k}{$j}{for};
 433                   $BeatPath{$i}{$j}{against} = ($BeatPath{$i}{$k}{for} <
 434                                                 $BeatPath{$k}{$j}{for}) ?
 435                                                   $BeatPath{$i}{$k}{against} :
 436                                                     $BeatPath{$k}{$j}{against};
 437                 }
 438                 $done = 0;
 439               }
 440             }
 441           }
 442         }
 443       }
 444     }
 445
 446
 447     # We construct the Schwartz set from the set of transitive defeats.
 448     foreach my $i (0..($max_choices - 1)) {
 449       if ($Drop{$i}) {
 450         $Schwartz[$i] = 0;
 451       } else {
 452         $Schwartz[$i] = 1;
 453       }
 454     }
 455
 456     foreach my $i (0..($max_choices - 1)) {
 457       foreach my $j (0..($max_choices - 1)) {
 458         next if $i == $j;
 459         # An option A is in the Schwartz set if for all options B, either
 460         # A transitively defeats B, or B does not transitively defeat A
 461         # Here, we throw out any option $i that does not meet the above
 462         # criteria.
 463         if (! ($BeatPath{$i}{$j}{for} || ! $BeatPath{$j}{$i}{for})) {
 464           $Schwartz[$i] = 0;
 465         }
 466       }
 467     }
 468     print {$RESULTS} "The Schwartz Set contains:\n";
 469     foreach my $i (0 ..$#Schwartz) {
 470       next unless $Schwartz[$i];
 471       print {$RESULTS} "\t Option ", $order_to_options{$i + 1}{key}, " \"",
 472         $order_to_options{$i + 1}{name}, "\"\n";
 473     }
 474     print {$RESULTS} "\n\n";
 475
 476     # If there are defeats between options in the Schwartz set, we drop
 477     # the weakest such defeats from the list of pairwise defeats, and
 478     # return to step 5.
 479
 480     #  1. A defeat (A,X) is weaker than a defeat (B,Y) if V(A,X) is
 481     #     less than V(B,Y). Also, (A,X) is weaker than (B,Y) if V(A,X) is
 482     #     equal to V(B,Y) and V(X,A) is greater than V(Y,B).
 483
 484     #  2. A weakest defeat is a defeat that has no other defeat weaker
 485     #  than it. There may be more than one such defeat.
 486
 487     # Check to see if there is anything in the Schwartz set that has no
 488     # defeats.
 489     my %Weakest;
 490     my $weak_count = 0;
 491     foreach my $i (0 ..$#Schwartz) {
 492       next unless $Schwartz[$i];
 493       foreach my $j (0..$#Schwartz) {
 494         next unless $Schwartz[$j];
 495         next if $i == $j;
 496         if (defined $Defeats{$i}{$j}{'for'}) {
 497           if (! $weak_count) {
 498             $Weakest{$weak_count}{'for'}     = $Defeats{$i}{$j}{for};
 499             $Weakest{$weak_count}{'against'} = $Defeats{$i}{$j}{against};
 500             $Weakest{$weak_count}{'Winner'}  = $i;
 501             $Weakest{$weak_count}{'Loser'}   = $j;
 502             $weak_count++;
 503           } elsif ($Weakest{0}{'for'} > $Defeats{$i}{$j}{for}) {
 504             undef %Weakest;
 505             $weak_count = 0;
 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             if ($Weakest{0}{'against'} < $Defeats{$i}{$j}{against}) {
 513               undef %Weakest;
 514               $weak_count = 0;
 515               $Weakest{$weak_count}{'for'}     = $Defeats{$i}{$j}{for};
 516               $Weakest{$weak_count}{'against'} = $Defeats{$i}{$j}{against};
 517               $Weakest{$weak_count}{'Winner'}  = $i;
 518               $Weakest{$weak_count}{'Loser'}   = $j;
 519               $weak_count++;
 520             } else {
 521               $Weakest{$weak_count}{'for'}     = $Defeats{$i}{$j}{'for'};
 522               $Weakest{$weak_count}{'against'} = $Defeats{$i}{$j}{'against'};
 523               $Weakest{$weak_count}{'Winner'}  = $i;
 524               $Weakest{$weak_count}{'Loser'}   = $j;
 525               $weak_count++;
 526             }
 527           }
 528         }
 529         if (defined $Defeats{$j}{$i}{'for'}) {
 530           if (! $weak_count) {
 531             $Weakest{$weak_count}{'for'}     = $Defeats{$j}{$i}{'for'};
 532             $Weakest{$weak_count}{'against'} = $Defeats{$j}{$i}{'against'};
 533             $Weakest{$weak_count}{'Winner'}  = $j;
 534             $Weakest{$weak_count}{'Loser'}   = $i;
 535             $weak_count++;
 536           } elsif ($Weakest{0}{'for'} > $Defeats{$j}{$i}{'for'}) {
 537             undef %Weakest;
 538             $weak_count = 0;
 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}{'Low'} == $Defeats{$j}{$i}{'for'}) {
 545             if ($Weakest{0}{'against'} < $Defeats{$j}{$i}{'against'}) {
 546               undef %Weakest;
 547               $weak_count = 0;
 548               $Weakest{$weak_count}{'for'}    = $Defeats{$j}{$i}{'for'};
 549               $Weakest{$weak_count}{'against'} = $Defeats{$j}{$i}{'against'};
 550               $Weakest{$weak_count}{'Winner'} = $j;
 551               $Weakest{$weak_count}{'Loser'}  = $i;
 552               $weak_count++;
 553             } else {
 554               $Weakest{$weak_count}{'for'}     = $Defeats{$j}{$i}{'for'};
 555               $Weakest{$weak_count}{'against'} = $Defeats{$j}{$i}{'against'};
 556               $Weakest{$weak_count}{'Winner'}  = $j;
 557               $Weakest{$weak_count}{'Loser'}   = $i;
 558               $weak_count++;
 559             }
 560           }
 561         }
 562       }
 563     }
 564     if (! $weak_count) {
 565       print {$RESULTS} "\n", "-=" x 35, "\n";
 566       print {$RESULTS} "-=" x 35, "\n\n";
 567       print {$RESULTS} "The winners are:\n";
 568       foreach my $i (0 ..$#Schwartz) {
 569         next unless $Schwartz[$i];
 570         print {$RESULTS} "\t Option ", $order_to_options{$i + 1}{key}, " \"",
 571           $order_to_options{$i + 1}{name}, "\"\n";
 572       }
 573       print {$RESULTS} "\n", "-=" x 35, "\n";
 574       print {$RESULTS} "-=" x 35, "\n\n";
 575       last;
 576     } else {
 577       print {$RESULTS} "Weakest Defeat(s): \n";
 578       foreach my $k (sort keys %Weakest) {
 579         print {$RESULTS} "\tOption ", $order_to_options{$Weakest{$k}{'Winner'} + 1}{key},
 580           " beats Option ", $order_to_options{$Weakest{$k}{'Loser'} + 1}{key}, " by ",
 581             " ($Beat_Matrix[$Weakest{$k}{'Winner'}][$Weakest{$k}{'Loser'}] - ",
 582               "$Beat_Matrix[$Weakest{$k}{'Loser'}][$Weakest{$k}{'Winner'}])\t",
 583                 "= ", $Weakest{$k}{'for'} - $Weakest{$k}{'against'}, " votes\n";
 584       }
 585       print {$RESULTS} "Deleting weakest defeat(s)\n\n";
 586       foreach my $k (sort keys %Weakest) {
 587         delete $Defeats{$Weakest{$k}{'Winner'}}{$Weakest{$k}{'Loser'}};
 588       }
 589   }
 590 }
 591 }
 592
 593
 594
 595
 596
 597 exit 0;
 598
 599
 600 =head1 CAVEATS
 601
 602 This is very inchoate, at the moment, and needs testing.
 603
 604 =cut
 605
 606 =head1 BUGS
 607
 608 None Known so far.
 609
 610 =cut
 611
 612 =head1 AUTHOR
 613
 614 Manoj Srivastava <srivasta@debian.org>
 615
 616 =head1 COPYRIGHT AND LICENSE
 617
 618 This script is a part of the Devotee package, and is
 619
 620 Copyright (c) 2002, 2003, 2004, 2005  Manoj Srivastava <srivasta@debian.org>
 621
 622 This program is free software; you can redistribute it and/or modify
 623 it under the terms of the GNU General Public License as published by
 624 the Free Software Foundation; either version 2 of the License, or
 625 (at your option) any later version.
 626
 627 This program is distributed in the hope that it will be useful,
 628 but WITHOUT ANY WARRANTY; without even the implied warranty of
 629 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 630 GNU General Public License for more details.
 631
 632 You should have received a copy of the GNU General Public License
 633 along with this program; if not, write to the Free Software
 634 Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 635
 636 =cut
 637
 638
 639
 640 __END__
 641