stv: wip, delay transfer

diff --git a/stv b/stv
index bd4a6b3f7447328c6ae17a2ce6d6e0c516d4eeb6..762da6359ed848ee63833b25f827df381ec128c6 100755 (executable)
--- a/stv
+++ b/stv
@@ -73,6 +73,18 @@ foreach my $vote (@allvotes) {
     $continuing{$_}=1 foreach @{ $vote->{Prefs} };
 }
 
     $continuing{$_}=1 foreach @{ $vote->{Prefs} };
 }
 

+sub equalpiles ($@) {
+    my ($how, @sorted) = @_;
+    return () unless @sorted;
+    my $s = $sorted[0];
+    my $eqtotal = $s->{Total};
+    my $count = 0;
+    while ($count < @$sorted && $sorted[$count]{Total} == $eqtotal) {
+       printf "%7s %10s\n", $how, $sorted[$count]{Cand};
+       $count++;
+    }
+    
+

 for (;;) {
     $stage++;
 
 for (;;) {
     $stage++;
 


@@ -92,7 +104,11 @@ for (;;) {
            $sorted{$firstpref}{Total} += $vote->{Weight};
        }
     }
            $sorted{$firstpref}{Total} += $vote->{Weight};
        }
     }

-    my @sorted = nsort_by { -$_->{Total} } values %sorted;
+    my @sorted;
+    my $sort_update = sub {
+       @sorted = nsort_by { -$_->{Total} } values %sorted;
+    };
+    $sort_update->();

 
     push @stagerecord, { map { ($_->{Cand}, $_->{Total}) } @sorted };
 
 
     push @stagerecord, { map { ($_->{Cand}, $_->{Total}) } @sorted };
 


@@ -145,26 +161,71 @@ for (;;) {
            votelog $vote, "elected $s->{Cand}, derated $weightmult";
            $vote->{Weight} /= $derate;
        }
            votelog $vote, "elected $s->{Cand}, derated $weightmult";
            $vote->{Weight} /= $derate;
        }

-       shift @sorted;

        push @surpluses, $s;
        push @surpluses, $s;

-       delete %sorted->{ $s->{Cand} };
+       delete %sorted{ $s->{Cand} };

        delete $continuing{ $s->{Cand} };
 
        delete $continuing{ $s->{Cand} };
 

+       $sort_update->();

        $need_to_transfer_surplus = 0;
        # before actually transferring a surplus, we will consider
        # eliminating, and then reconsider with a lower quota
     }
 
        $need_to_transfer_surplus = 0;
        # before actually transferring a surplus, we will consider
        # eliminating, and then reconsider with a lower quota
     }
 

+    my $deferredsurplus = sum map { $_->{Total} } @surpluses;
+    printf "%7s %10s %s\n", 'def.srp', 'total', pr $deferredsurplus;
+

     # Look for people to eliminate
     # We eliminate before trying to transfer surpluses
     # ERS 5.2.5
     # Look for people to eliminate
     # We eliminate before trying to transfer surpluses
     # ERS 5.2.5

+    for (;;) {
+       last unless @sorted;
+
+       my @elim = equalpiles 'elim?', reverse @sorted;
+       my $elimvote = sum map { $_->{Total} } @elim;
+       my $elimvotetotal = $elimvote * scalar @elim;
+
+       if (@surpluses and $elimvotetotal > $deferredsurplus) {
+           printf "no-elim, un-defer\n";
+           last;
+       }
+
+       if ((scalar keys %continuing) - (scalar @elim) < $placesremain) {
+           # eliminate only one then, and try again
+           printf "elim-tie!\n";
+           @elim = historically_prefer -1, @elim;
+       }
+
+       foreach my $s (@elim) {
+           my $c = $s->{Cand};
+           printf "%7s %10s\n", 'ELIM', $c;
+           my $votes = $s->{Votes};
+           votelog $_, "failed to stop $c elimination" foreach @$votes;
+           delete %continuing{$c};
+           delete %sorted{$c};
+           push @unsorted, @$votes;
+       }
+       
+       $sort_update->();
+       $need_to_transfer_surplus = 0;
+    }

     
     

-    
-       # transfer the surplus
-       filterout $topfirst, "candidate was elected";
-    } else {
-       my $elim = $sorted{ $#sorted };
-       printf "%10s eliminated\n", $elim;
-       filterout $elim, "candidate was eliminated";
+    next unless $need_to_transfer_surplus;
+
+    @surpluses = nsort_by { $_->{Total} }, @surpluses;
+    my @surplusxfer = equalpiles 'xfer?', @surpluses;
+    die unless @surplusxfer;
+
+    if (@surplusxfer > 1) {
+       @surplusxfer = historically_prefer +1, @surplusxfer;

     }
     }

+
+    my $s = $surplusxfer[0];
+    my $c = $s->{Cand};
+    printf "%7s %10s\n", 'xfer', $c;
+    my $votes = $s->{Votes};
+    votelog $_, "surplus transferred" foreach @$votes;
+    @surpluses = grep { $_->{Cand} ne $c } @surpluses;
+    push @unsorted, @$votes;

 }
 }

+
+print "done.\n";