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