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