#!/usr/bin/perl -w

#   Copyright (c) 2004-2007 Jonathan Lundell; All Rights Reserved.
#
#   IMPORTANT: This software is supplied to you by Jonathan
#   Lundell ("Jonathan") in consideration of your agreement to
#   the following terms, and your use, installation,
#   modification or redistribution of this software
#   constitutes acceptance of these terms. If you do not
#   agree with these terms, please do not use, install,
#   modify or redistribute this software.
#
#   In consideration of your agreement to abide by the
#   following terms, and subject to these terms, Jonathan grants
#   you a personal, non-exclusive license to use, reproduce,
#   modify and redistribute this software, with or without
#   modifications, in source and/or binary forms; provided
#   that if you redistribute the software with
#   modifications, you must remove this copyright notice and
#   the following text and disclaimers in all such
#   redistributions. The name Jonathan Lundell and/or this
#   product may not be used to endorse or promote products
#   derived from this software without specific prior
#   written permission from Jonathan. Except as expressly stated
#   in this notice, no other rights or licenses, express or
#   implied, are granted by Jonathan herein, including but not
#   limited to any patent rights that may be infringed by
#   your derivative works or by other works in which the
#   software may be incorporated.
#
#   This software is provided by Jonathan on an "AS IS" basis. 
#   JONATHAN MAKES NO WARRANTIES, EXPRESS OR IMPLIED, INCLUDING
#   WITHOUT LIMITATION THE IMPLIED WARRANTIES OF
#   NON-INFRINGEMENT, MERCHANTABILITY AND FITNESS FOR A
#   PARTICULAR PURPOSE, REGARDING THE SOFTWARE OR ITS USE
#   AND OPERATION ALONE OR IN COMBINATION WITH YOUR
#   PRODUCTS.
#
#   IN NO EVENT SHALL JONATHAN BE LIABLE FOR ANY SPECIAL,
#   INDIRECT, INCIDENTAL OR CONSEQUENTIAL DAMAGES
#   (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
#   SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
#   PROFITS; OR BUSINESS INTERRUPTION) ARISING IN ANY WAY
#   OUT OF THE USE, REPRODUCTION, MODIFICATION AND/OR
#   DISTRIBUTION OF THE SOFTWARE, HOWEVER CAUSED AND WHETHER
#   UNDER THEORY OF CONTRACT, TORT (INCLUDING NEGLIGENCE),
#   STRICT LIABILITY OR OTHERWISE, EVEN IF JONATHAN HAS BEEN
#   ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

package STV;
use strict;
use Exporter;
use POSIX;	# for floor()
our @ISA = qw(Exporter);
our @EXPORT = qw(&countSTV VERBOSE_RESULTS VERBOSE_WARNINGS VERBOSE_DETAILS VERBOSE_DUMP VERBOSE_DUMPALL);

our $VERSION="2.15";

#  STV.pm
#
#  v2.15 2007-07-17  support fractional ballot multiplier
#  v2.14 2007-06-09  fix approval multiplier (reporting only)
#                    round dump numbers
#                    include total approval in random seed
#                    support nonrandom tiebreaking for testing
#  v2.12, 2.13       experimental fixed-point implementation; never published
#  v2.11 2007-05-28  remove experimental multiple-round BC variation
#  v2.10 2007-05-15  Meek/Warren: defer election of candidates with exactly a quota
#                    use $methodname in Meek/Warren messages
#  v2.09 2007-05-15  fix provisional Meek/Warren case
#  v2.08 2007-05-13  fix typos in Meek/Warren tiebreaking
#                    add method=gpca2000
#                    default to Droop quota
#  v2.07 2006-03-04  better formatting for sample ballot file
#  v2.06 2006-03-04  don't elect remaining after all seats filled
#                    maintain precision and round for comparisons
#                    Meek: report tiebreaks
#  v2.05 2006-02-12  move to Knuth integer RNG
#  v2.04 2006-01-29  Meek: improve reporting
#                    use rounding
#                    detect Meek iteration loop
#  v2.03 2006-01-21  BC: elect leftover candidates if quota not mandatory
#  v2.02 2006-01-14  calculate available precision
#                    increase precision of Meek/Warren iteration test
#                    support ballot multiplier
#                    accept .blt as input
#                    eliminate leftover BC hopefuls
#                    reorganize for readability
#                    fix duplicate-rank detection
#                    centralize fatal/warning handling
#                    return fatal/worning messages to caller
#  v2.01 2006-01-06  support Warren's method
#                    prettify Meek/Warren dumper a little
#  v2.00 2006-01-05  support Meek's method
#                    add method to create .blt file for OpenSTV
#  v1.16 2006-01-01  remove approval tiebreaker
#  v1.15 2005-12-24  use unbuffered output
#  v1.14 2005-12-10  change $break to $tiebreak for readability
#  v1.13 2005-11-23  show per-round vote totals
#                    show decision criterion (vote/approval/random)
#  v1.12 2005-11-18  initialize residual approval for initial dump
#  v1.11 2005-08-07  split into subroutines
#                    eliminate hopeless candidates
#                    iterate if mandatory quota and unfilled seats
#  v1.10 2005-04-17  convert to module
#  v1.0b9 2005-04-09  cleanup, unified verbose flag
#  v1.0b8 2004-12-05  fix mandatory-quota reporting
#  v1.0b7 2004-12-04  need numeric sort for >9 rankings
#  v1.0b6 2004-12-03  fix ballot-format-checking pattern for order= ballots
#  v1.0b5 2004-06-29  comments, rename variables, reorganize
#  v1.0b4 2003-11-17  quota=strict option
#  v1.0b3 2003-11-13  remove NOC logic
#                     flexible ballots= ordering
#                     allow numeric quota
#  v1.0b2 2003-11-12  change "NOTA" to "NOC"
#  v1.0b1 2003-11-11
#
#  TODO: prettier round-by-round details of counts
#  TODO: implement sequential STV
#  TODO: implement Condorcet
#
#  Count a ranked-choice-voting STV election,
#    with fractional transfers and fractional quota.
#
#  The input file looks like this (case-insensitive):
#
=begin ballot-file

title=Centerville City Council Election 2006-11-01
# comments
method=BC		# BC: British Columbia STV with fractional quota
				# GPCA2000: Green Party of California rules adopted 2000
				#           implies BC, mandatory droop quota
				# Meek: Meek's Method (Algorithm 123)
				# Warren: Warren's Method (Algorithm 123)
				# blt: produce .blt file for OpenSTV, etc
seats=3
quota=droop		# droop: (ballots / (seats+1))
				# hare: (ballots / seats)
				# Meek/Warren only:
				#   droop2: Droop w/minimum quota of Droop/2
				#   hare2: Hare w/minimum quota of Hare/2
#quota=103		# specify numeric quota (rare!)
quota=mandatory	# all winners must pass quota
random=37863	# seed for coin-toss tiebreaker
random=non		# non-random option for testing (use candidate entry order)
candidate=gb George Brown
candidate=mg Mary Green
candidate=ht Hermione Tan
candidate=hb Harvey Black
candidate=vs Violet Smith
withdrawn=jw Janet Weiss	# allow votes, but don't count them
#ballots=blt	# optional format: see below for .blt format
				#   (don't specify seats= title= ballots=<count>
				#    candidate= or withdrawn=)
ballots=34
gb ht hb
vs mg
... (for a total of 34 ballot lines in this example)
end

#  Alternate ballot format
#  (same as above through candidate=)

order=gb ht mg hb vs	# order of candidates on ballot
ballots=34
1 2 - 3 - -
- - 2 1 - -
...
end

=end ballot-file
=cut

#  Optionally, each ballot line can begin with (eg) 10X,
#  meaning that the line represents (eg) 10 identical ballots.
#  The default is 1X.

#  Three ballot formats are supported.
#
#  Format 1: The ballot has one blank line per candidate, labeled 1, 2, 3, etc.
#            The voter fills in the name of candidates in preference order.
#            The ballots are very general, and no candidate benefits 
#            from being first on the list. It allows write-ins, if desired.
#            Do not use the "order=" option with this format.
#
#  Format 2: The ballot lists the candidates, one per line.
#            The voter writes a rank number 1, 2, 3, etc next to candidate
#            names. Write-ins can be accommodated with blank lines.
#            Use the "order=" option with this format.
#
#  Format 3: .blt
#            If ballots=blt, the remainder of the file should be in .blt format.
#            The first line contains the number of candidates and the number of seats.
#            Additional lines of the form -\d+ indicate withdrawn candidates.
#            Ballot lines start with a multiplier, nicknames implicitly 1..n,
#            and end with 0.
#            Following the ballots is a list of candidate names, in order and in quotes.
#            Last is the election title.
#
#  Nicknames (initials or first names or any unique designation) are used to make the
#    format-1 ballot entries easier, and are used for the order= command in format 2.
#
#  The program will object if a ballot has an unknown nickname, or the same nickname appears twice,
#    or (in format 2) if the same rank number appears twice, or if numbers are skipped.
#
#  quota=mandatory (optional) in addition to the quota type specifies that passing
#    the quota is strictly required to be elected. Otherwise all seats are filled
#    (if possible) from the remaining active candidates even if they have not passed the
#    quota.
#
#  ballots= lets the program check the number of ballots actually entered.
#    ballots= and the ballots themselves must be the last lines in the file, terminated by "end".
#    Optionally, ballots=blt signals that a .blt-format file follows.
#
#  title= specifies an arbitrary title for the output of the program.
#         Generally, it should have the name and date of the election.
#
#  Ideally, two files should be created, by different teams, and the results compared;
#    the final results should be identical, though the finishing order might vary if the
#    ballots are not in the same order.

#  Contact jlundell at greens dot org with comments, suggestions, or bug reports.
#  For bug reports, please include a copy of the program used, plus the election file(s).

my $version = $VERSION;

use constant VERBOSE_RESULTS => 0;	# print results only
use constant VERBOSE_WARNINGS => 1;	# also print error warnings
use constant VERBOSE_DETAILS => 2;	# also print details
use constant VERBOSE_DUMP => 3;		# also print dump
use constant VERBOSE_DUMPALL => 4;	# also print dump details

use constant METHOD_BC => 0;		# British Columbia with random tiebreaking
use constant METHOD_MEEK => 1;		# Meek's method
use constant METHOD_WARREN => 2;	# Warren's method
use constant METHOD_BLT => 3;		# create .blt file for (eg) OpenSTV
use constant METHOD_GPCA2000 => 4;	# GPCA 2000 (BC, mandatory droop quota)

our $verbose = VERBOSE_WARNINGS;
our $method = METHOD_GPCA2000;
our $methodname;
our $quotaName = "Droop";	# default to Droop quota
our $quota;				# vote-count quota needed to be elected
our $quotaNum;			# quota numerator
our $quotaDiv;			# quota divisor
our $minQuota;			# minimum quota
our $quotaSet = 0;		# absolute quota
our $nballots = 0;		# number of ballots actually read
our $exhausted;			# total voting weight of exhausted ballots
our $fatalmsg;
our @warnings = ();
our $precision = 10;	# decimal places of precision

# global candidate-keyed hashes
our %cName = ();		# full name of candidate
our %cWithdrawn = ();	# withdrawn candidates (legal on ballots, but not counted)
our %cApproval = ();	# total approval, per candidate
our %cElected = ();		# elected candidates are entered here
our %cHopeful = ();		# hopeful candidates (neither elected or eliminated)
# BC-only
our %cResidualApproval = ();	# residual approval this round, per candidate
our %cPiles = ();		# pile of ballots for each candidate (references to anonymous arrays of ballots)
						# cPiles is the only data structure of non-trivial complexity
						# cPiles is a hash of ballot piles keyed by candidate nickname
						# each pile is an array of ballots (see below)
# Meek/Warren-only
our %cMeekWeight = ();	# Meek's method per-candidate weight
our %cMeekVotes = ();	# Meek's method per-candidate vote tally

#  variables that hold information from the input data file
#
my $title;				# title of election
our $seats;				# number of seats to be filled
our $mandatoryQuota = 0; # all winners must pass quota
our $ballots = 0;		# number of ballots specified in ballots= line
						# each ballot is a hash with members MULT, PREFS, INDEX, WEIGHT
						#   MULT is a count (default 1) of identical ballots collapsed into one record
						#   PREFS is an array of voter preferences (candidate nicknames)
						#   INDEX is the current index into PREFS
						#   WEIGHT is the current weight of the ballot, initially 1, always <= 1.
						#   WEIGHT is reduced when the ballot is transferred from an elected candidate

#  file-global variables
#
my $seed = 2718281828;	# random seed
my $nonrandom = 0;		# random=non (for testing)
my %cRandom = ();		# random number, per candidate, for tie-breaking
my %cOrder = ();		# order of candidates as entered
my %order = ();			# candidate order on format-2 ballot
my @ballots = ();		# array of all ballot structs

my $doorder = 0;		# using format-2 ballots
my $lineno = 0;			# input line number for reporting purposes
my $maxMeekIterations = 0;
my $rounds = 0;
my $readBLT = 0;		# read ballots in .blt format
my $totalApproval = 0;

my $ballotspath;
my $resultspath;
my $ballotsfile;	# ballot-file handle
my $resultsfile;	# results-file handle

#  countSTV( ballots-file-path, results-file-path )
#  main procedure
#
sub countSTV {
	($ballotspath, $resultspath, $verbose) = @_;
	#
	#  Handle fatal-error exceptions
	#
	eval { docount() };
	if ($@) {
		$fatalmsg = $@;
		return;		# return undef
	}
	return 1;
} # sub countSTV()

sub docount {
	my $cand;

	$| = 1;	# unbuffered output

	#  open ballot and results files
	#
	if (defined $ballotspath) {
		open (BALLOTS, "< $ballotspath") or fatal("Can't open ballot file $ballotspath: $!");
	} else {
		open (BALLOTS, "<&STDIN");
	}

	if (defined $resultspath) {
		open (RESULTS, "> $resultspath") or fatal("Can't open results file $resultspath: $!");
	} else {
		open (RESULTS, ">&STDOUT");
	}

	$ballotsfile = *BALLOTS;
	$resultsfile = *RESULTS;

	read_params();	# read the election parameters
	read_ballots();	# read the ballots

	#  calculate available precision
	#
	my $epsilon = 1.0;
	my $bits = 0;
	my $laste = -1;
	while ((1.0 + $epsilon) > 1) {
		$laste = $epsilon;
		$bits += 1;
		$epsilon /= 2;
		last if $bits > 1000;
	}

	#  generate the tiebreaking ordering of candidates
	#  if nonrandom, use candidate entry order
	#
	rng_init();		# initialize random-number generator
	foreach $cand ( keys %cHopeful ) {	# for each hopeful candidate
		if ($nonrandom) {
			$cRandom{$cand} = $cOrder{cand};
		} else {
			$cRandom{$cand} = rng();		# tie-breaker
		}
	}

	#
	#  Having read all the parameters, candidates and ballots,
	#  now a little more value checking.
	#
	if ($verbose >= VERBOSE_DETAILS) {
		print $title . "\n" if defined($title);
		print "Version: " . $version . "\n";
		print "Seats: " . $seats . "\n";
		print "Ballots: " . $nballots . "\n";
		print "Internal precision: $bits bits; e: $laste\n";
	}

	fatal("ballot count ($nballots) does not match ballots=$ballots") if ($ballots != $nballots);

	if ($method == METHOD_BC) {
		$methodname = "British Columbia";
	} elsif ($method == METHOD_MEEK) {
		$methodname = "Meek";
	} elsif ($method == METHOD_WARREN) {
		$methodname = "Warren";
	} elsif ($method == METHOD_BLT) {
		$methodname = "blt";
	} elsif ($method == METHOD_GPCA2000) {
		$methodname = "GPCA2000";
		$method = METHOD_BC;
	} else {
		fatal("unknown method: $method");
	}

	#
	#  Determine the numeric quota as a function of
	#    * the quota type
	#    * the number of open seats
	#    * the number of ballots cast
	#
	#  "droop" is the default, and the method specified by the GPUS & GPCA bylaws.
	#
	if ($quotaName =~ /^droop$/i) {
		$quotaName = "Droop";
		$quotaNum = $nballots;
		$quotaDiv = $seats + 1;
		$minQuota = $mandatoryQuota ? 1 : 0;
	} elsif ($quotaName =~ /^droop2$/i) {
		$quotaName = "Droop2";
		$quotaNum = $nballots;
		$quotaDiv = $seats + 1;
		$mandatoryQuota = 1;
		$minQuota = 2;
	} elsif ( $quotaName =~ /^hare$/i ) {
		$quotaName = "Hare";
		$quotaNum = $nballots;
		$quotaDiv = $seats;
		$minQuota = $mandatoryQuota ? 1 : 0;
	} elsif ( $quotaName =~ /^hare2$/i ) {
		$quotaName = "Hare2";
		$quotaNum = $nballots;
		$quotaDiv = $seats;
		$mandatoryQuota = 1;
		$minQuota = 2;
	} elsif ( $quotaName =~ /^(\d+)\/(\d+)/ ) {
		$quotaName = "Explicit";
		$quotaNum = $1;
		$quotaDiv = $2;
		$quotaSet = 1;
		$minQuota = $mandatoryQuota ? 1 : 0;
	} else {
		fatal("unknown quota: $quotaName");
	}

	$exhausted = 0.0;
	$quota = $quotaNum / $quotaDiv;
	if ($minQuota == 1) {
		$minQuota = $quota;
	} elsif ($minQuota == 2) {
		$minQuota = $quota / 2;
	} else {
		$minQuota = 0;
	}

	if ($verbose >= VERBOSE_DETAILS) {
		print "Method: $methodname\n";
		print "Quota: $quota:$minQuota ($quotaName)\n";
	}

	methodBC() if ($method == METHOD_BC);
	methodMeek() if ($method == METHOD_MEEK || $method == METHOD_WARREN);
	if ($method == METHOD_BLT) {
		methodBLT();
		return 1;
	}

	#
	#  We've either filled all the available seats,
	#  or eliminated all the candidates.
	#
	#  Summarize results.
	#
	print "\nResults:\n" if ($verbose >= VERBOSE_DETAILS);
	foreach $cand ( keys %cName ) {	# for each candidate
		next if ( !$cElected{$cand} );
		print $resultsfile "Elected: " . $cName{$cand} . " (approval=" . $cApproval{$cand} . ")\n";
	}
	foreach $cand ( keys %cName ) {	# for each candidate
		next if ( !$cHopeful{$cand} );
		print $resultsfile "Hopeful: " . $cName{$cand} . " (approval=" . $cApproval{$cand} . ")\n";
	}
	foreach $cand ( keys %cName ) {	# for each candidate
		next if ( $cHopeful{$cand} || $cElected{$cand} || $cWithdrawn{$cand} );
		print $resultsfile "Eliminated: " . $cName{$cand} . " (approval=" . $cApproval{$cand} . ")\n";
	}
	foreach $cand ( keys %cName ) {	# for each candidate
		next if ( !$cWithdrawn{$cand} );
		print $resultsfile "Withdrawn: " . $cName{$cand} . " (approval=" . $cApproval{$cand} . ")\n";
	}

	close $resultsfile;
} # sub docount

#  internal procedure to read the election parameters from the ballots file
#  read_params()
#
sub read_params {

	#
	#  Read ballot file.
	#  In this loop we read up to the ballots= line.
	#
	while (<$ballotsfile>) {
		++$lineno;			# count lines

		#  Clean up the line
		#
		chomp();			# strip trailing newline
		s/^\s+//;			# strip leading whitespace
		s/#.*//;			# strip trailing comment
		s/\s+$//;			# strip trailing whitespace
		s/\s*=\s*/=/;		# strip whitespace around =
		next if ( /^$/ );		# skip empty lines & comments
		last if ( /^end/i );	# explicit end-of-file

		#  Do a little compatibility work for old ballot files
		#
		s/^threshold=/quota=/i;				# backward compatibility
		s/^quota=strict$/quota=mandatory/i;	# backward compatibility

		#  Parse the lines of the input file
		#  (except for ballots and "end").
		#
		if ( /^verbose=(.*)/i ) { $verbose = $1; next }		# verbosity
		if ( /^title=(.*)/i ) { $title = $1; next; }		# title
		if ( /^seats=(\d+)/i ) { $seats = $1; next; }		# number of seats
		if ( /^random=non/i ) { $nonrandom = 1; next; }		# nonrandome tiebreaking for testing
		if ( /^random=(\d+)/i ) { $seed = $1; next; }		# random seed

		if ( /^method=bc$/i ) { $method = METHOD_BC; next; }
		if ( /^method=meek$/i ) { $method = METHOD_MEEK; next; }
		if ( /^method=warren$/i ) { $method = METHOD_WARREN; next; }
		if ( /^method=blt$/i ) { $method = METHOD_BLT; next; }
		if ( /^method=gpca2000$/i ) {
			$method = METHOD_GPCA2000;
			$mandatoryQuota = 1;
			next;
		}

		#  Quota type. We'll evaluate it later.
		#
		if ( /^quota=mandatory$/i ) { $mandatoryQuota = 1; next; }
		if ( /^quota=(.*)/i ) { $quotaName = $1; next; }
		#
		#  order= says we're using format-2 ballots,
		#  where the ballot has a list of rankings.
		#  This line defines the order of candidates on the ballot.
		#
		if ( /^order=(.*)/i ) {
			my @cands = split /\s+/, $1;
			my $index = 0;
			my $cand;
			my $candx;
			foreach $cand ( @cands ) {
				foreach $candx ( keys %order ) {
					#
					#  A little sanity checking: complain about duplicates.
					#

					if ( $cand eq $order{$candx} ) {
						fatal("line $lineno: duplicate candidate in order=:  $cand");
					}
					#
					#  Make sure it's a candidate we know about.
					#
					if (not defined( $cName{$cand})) {
						fatal("line $lineno: unknown candidate in order=: $cand");
					}
				}
				++$index;	# 1, 2, 3...
				$order{$index} = $cand;	# record candidate's line on ballot
			}
			$doorder = 1;	# remember that we're format-2
			next;
		}
		#
		#  candidate= identifies a nickname and full name of a candidate.
		#
		if ( /^candidate=(\S+)\s+(.*)/i ) {
			fatal("duplicate nickname: $1") if ( $cName{$1} );
			$cName{$1} = $2;		# remember the candidate's full name
			$cOrder{$1} = $lineno;	# order of candidate entry
			$cHopeful{$1} = 1;		# hopeful until elected or eliminated
			$cApproval{$1} = 0;		# overall approval
			$cPiles{$1} = [ ];		# pile of ballots for this candidate
			next;
		}
		#
		#  withdrawn= identifies a nickname and full name of a withdrawn candidate.
		#
		if ( /^withdrawn=(\S+)\s+(.*)/i ) {
			fatal("duplicate nickname: $1") if ( $cName{$1} );
			$cName{$1} = $2;		# remember the candidate's full name
			$cOrder{$1} = $lineno;	# order of candidate entry
			$cWithdrawn{$1} = 1;	# flag as withdrawn
			$cApproval{$1} = 0;		# overall approval
			next;
		}
		#
		#  ballots= introduces the ballots, and must come last.
		#
		if ( /^ballots=(\d+)/i ) {
			$ballots = $1;			# ballot count for cross-checking
			last;
		}
		if ( /^ballots=blt/i ) {
			$readBLT = 1;			# ballots are in .blt format
			last;
		}

		#
		#   We didn't recognize this line.
		#
		fatal("Unknown input on line $lineno: $_");
	}

	fatal("No ballots found") if ( !$readBLT && $ballots == 0 );

	return 1;
} # sub read_params()

#  internal procedure to read the ballots from the ballots file
#  read_ballots()
#
sub read_ballots() {
	my $ncand = 0;

	#  Now read the ballots.
	#
	while (<$ballotsfile>) {
		++$lineno;			# count lines
		chomp();			# strip trailing newline
		s/^\s+//;			# strip leading whitespace
		s/#.*//;			# strip trailing comment
		s/\s+$//;			# strip trailing whitespace
		s/\s*=\s*/=/;		# strip whitespace around =

		next if ( /^$/ );		# skip empty lines & comments
		last if ( /^end/i );	# explicit end-of-file
		if ( $readBLT == 1 ) {
			/^(\d+)\s+(\d+)/;
			$seats = $2;
			for (my $i = 1; $i <= $1; ++$i) {
				$cName{$i} = $i;		# temporarily name each .blt candidate
				$cHopeful{$i} = 1;		# hopeful until elected or eliminated
				$cApproval{$i} = 0;		# overall approval
				if ($nonrandom) {
					$cRandom{$i} = $i
				} else {
					$cRandom{$i} = rng();	# tie-breaker
				}
				$cPiles{$i} = [ ];		# pile of ballots for this candidate
			}
			++$readBLT;
			next;
		}
		if ( $readBLT == 2 ) {
			if ( /^-(\d+)/ ) {
				$cWithdrawn{$1} = 1;	# flag as withdrawn
				next;
			} else {
				++$readBLT;
			}
		}
		if ( $readBLT == 4 ) {
			my $line = $_;
			while ( $line =~ /^\"(.*?)\"\s*(.*)/ ) {
				++$ncand;
				$cName{$ncand} = $1;
				$line = $2;
			}
			++$readBLT if ( $ncand >= keys(%cName) );
			next;
		}
		if ( $readBLT == 5 ) {
			$title = $_;
			$title =~ s/\"//g;	# strip quotes from .blt title
			last;
		}

		#
		# %ballot is a hash, with:
		#   MULT, the ballot multiple
		#	a ranked list of nicknames PREFS (array ref),
		#   the current choice INDEX, and 
		#	the current WEIGHT.
		#
		# We build %ballot and then push it onto the pile
		# of its first-choice candidate.
		#
		my %ballot = ();			# an empty ballot hash
		my $mult = 1.0;
		if ( $readBLT == 3 ) {
			if ( /^0/ ) {
				++$readBLT;			# end of .blt ballots
				next;
			}
			if ( /^(\d+)\s*(.*)/i ) {
				$mult = $1;
				$_ = $2;
			}
		} else {
			#
			#  Look for a ballot-weight multiplier of the form 10X or 0.5X or 1/2X
			#
			if ( /^(\d+)X\s*(.*)/i ) {			# 10X
				$mult = $1;
				$_ = $2;
			} elsif ( /^(\d+\.\d*)X\s*(.*)/i ) {	# 0.5X
				$mult *= $1;
				$_ = $2;
			} elsif ( /^(\d+)\/(\d+)X\s*(.*)/i ) {	# 1/2X
				$mult *= $1;
				$mult /= $2;
				$_ = $3;
			}
		}
		if ($readBLT) {
			s/\s+0$//;				# remove terminal 0
		}

		my @prefs = split /\s+/;	# split the ballot line
									# into individual votes
		my @votes;
		my $vote;
		my %checkdupes = ();
		$ballot{ MULT } = $mult;	# ballot multiplier
		$ballot{ INDEX } = 0;		# this ballot is voting for its first choice
		$ballot{ WEIGHT } = 1;		# each ballot counts one vote to start with
									# the weight can go down if a winner's
									# excess votes are redistributed
		#
		#  If we're using format-2 ballots (order=)
		#  convert the ballot to format 1.
		#
		if ( $doorder ) {

			# All we allow are numeric ranks or '-' for no rank
			#
			fatal("Unknown input on line $lineno: " . "$_") if ( !/^[0-9- ]+(#.*)?$/i );

			my $c = 0;
			my %temp;
			my %ranks = ();
			#
			#  scan over rankings
			#
			foreach $vote ( @prefs ) {
				++$c;						# next candidate on ballot
				next if $vote eq "-";		# no ranking for this candidate
				#
				# Detect duplicate ranking (eg 1 2 2 3 4).
				# We'll report it, and let it go.
				# The ranking will be arbitrary.
				# Counters should check the ballot.
				#
				warning("line $lineno: duplicate rank $vote") if ($ranks{$vote});
				$ranks{$vote} = 1;
				$temp{$vote} = $order{$c};	# this candidate's rank on ballot
			}
			#
			#  Sort by rank and rebuild @prefs in rank order.
			#
			@prefs = ();
			my $lastvote = 0;
			foreach $vote (sort { $a <=> $b } keys %temp) {
				#
				# Detect skipped ranking (eg 1 2 3 5).
				# Report it and accept it.
				# Counters should check the ballot.
				#
				if ( $vote != ($lastvote+1) ) {
					my $lv1 = $lastvote + 1;
					warning("line $lineno: skipped rank $lv1");
				}
				$lastvote = $vote;
				push @prefs, $temp{$vote};
			}
		}
		#
		#  Now either we have a format-1 ballot,
		#  or a format-2 ballot that's been converted to format 1.
		#  Validate the ballot and create an array of rankings
		#
		foreach $vote ( @prefs ) {
			#
			#  For each candidate, make sure s/he exists in the list.
			#  Counters should check the ballot and resolve the problem
			#  if possible.
			#
			#  The ballot will not be counted!
			#
			if (!$readBLT && !defined( $cName{$vote} )) {
				warning("line $lineno: vote for unknown candidate: $vote");
			#
			#  Check whether this candidate appears twice on this ballot.
			#  Counters should check the ballot and resolve the problem
			#  if possible.
			#
			#  The ballot will not be counted!
			#
			} elsif ( $checkdupes{$vote} ) {
				warning("line $lineno: duplicate vote for: $vote");
			#
			#  If the candidate preference looks good,
			#  put it in the preference array,
			#  Bump the approval count for this candidate.
			#  
			} else {
				$checkdupes{$vote} = 1;
				push @votes, $vote;
				$cApproval{$vote} += $ballot{ MULT };
				$totalApproval += $ballot{ MULT };
			}
		}
		#
		#  %ballot contains MULT, INDEX, WEIGHT and PREFS
		#  Save the prefs in the %ballot.
		#  Push each %ballot onto @ballots
		#
		$ballot{ PREFS } = [ @votes ];
		push @ballots, { %ballot };

		$nballots += $mult;			# count the ballots
		next;
	}
	$ballots = $nballots if ( $readBLT );
	close $ballotsfile;
	return 1;
} # sub read_ballots()

#  Count using Meek's or Warren's method (Algorithm 123)
#
## 2.1
## At each stage, each candidate is in one of three states,
## designated as ÔelectedÕ, ÔexcludedÕ and ÔhopefulÕ. At
## the start every candidate is in the hopeful state.
##
## 2.2
## At each stage the votes are scanned, and the one vote
## allowed to each voter may be split into parts that are assigned
## to the various candidates according to the voterÕs
## choices. At the first stage the whole of the vote goes to
## the first choice Ñ this follows automatically from the
## operation of rules 2.1 and 2.3.
##
## 2.3
## Each candidate, x, has an associated weight, w.x, and
## keeps a proportion w.x of each vote or part of a vote received,
## while passing on to another candidate (as specified
## by the voterÕs choices) a proportion 1 - w.x. Every
## hopeful candidate has weight 1, and therefore keeps
## everything received and passes nothing on. Every excluded
## candidate has weight 0, and therefore keeps
## nothing and passes everything on. Elected candidates
## have weights between 0 and 1, to be calculated by rule
## 2.5.
## 
## 2.4 (Meek)
## Thus if someone has voted for candidate a as first
## choice, b as second, c as third, and no more:
##
## * a receives from that voter w.a of a vote
## * b receives from that voter (1 - w.a)w.b of a vote
## * c receives from that voter (1 - w.a)(1 - w.b)w.c   
##   of a vote
##
## A fraction (1 - w.a)(1 - w.b)(1 - w.c) remains and
## this goes to ÔexcessÕ. (Note that if a hopeful candidate
## appears in the list, all the fractions beyond that point
## automatically become 0).
## 
## 2.4 (Warren)
## Thus if someone has voted for candidate a as first
## choice, b as second, c as third, and no more:
##
## * a receives from that voter w.a of a vote
## * b receives from that voter min((1 - w.a, w.b) of a vote
## * c receives from that voter min((1 - w.a - w.b), w.c)   
##   of a vote
##
## If a fraction remains,
## this goes to ÔexcessÕ. (Note that if a hopeful candidate
## appears in the list, all the fractions beyond that point
## automatically become 0).
## 
## 2.5
## The quota is defined as (total votes - total excess) / 
## (number of seats + 1), and the weights for elected
## candidates are found such that the total vote remaining
## with each of them equals the quota. This is done by the
## convergent iterative scheme specified in rule 2.9.
## 
## 2.6
## The weights having been found, the resulting total votes
## for each hopeful candidate are examined, and any candidate
## whose total votes equal or exceed the quota
## changes state from hopeful to elected (except in the special
## case where all the hopeful candidates either have
## zero votes or exactly equal the quota. In this case all
## those with zero votes are excluded, one other is excluded
## by a pseudo-random choice and the others are
## elected).
## 
## 2.7
## If no candidate were elected under rule 2.6, then the
## hopeful candidate with the fewest votes changes state
## from hopeful to excluded. Any tie is resolved by a
## pseudo-random choice.
## 
## 2.8
## If the total number of elected candidates is equal to the
## number of seats, the election is complete. Otherwise the
## process is repeated from rule 2.2.
## 
## 2.9
## The convergent iterative scheme is as follows: set w.j
## equal to 0 for excluded candidates, 1 for hopeful candidates,
## and their last calculated values w.j0, for elected
## candidates. (Immediately after election of any candidate
## the last calculated value is 1 initially.) Applying
## rule 2.3, using these weights, let v.j be the total value
## of votes received by candidate j and let e be the total
## excess. Using this value for e, calculate the new quota
## q using rule 2.5. Finally update the weights for elected
## candidates to values w.j1 = w.j0 * q/v.j. Repeat the process
## of successively updating v.j, e, q and  w.j until every fraction
## q/v.j, for elected candidates, lies within the limits
## 0.99999 and 1.00001 (inclusive).
##

#  Count election using Meek's or Warren's method
#  Option: set quota other than Droop
#  Option: set minimum quota
#
sub methodMeek {
	my $cand;
	my $excess = 0.0;
	my $rounds = 1;

	# 2.1,2.3: set initial weight for each candidate
	# (implicitly one for hopeful candidates; calculated for elected candidates)
	#
	%cMeekWeight = ();

	# Extension: eliminate hopeless candidates based on overall approval
	#
	foreach $cand ( keys %cHopeful ) {	# for each hopeful candidate
		if ($cApproval{$cand} < $minQuota) {
			print "  eliminate $cName{$cand} (hopeless: approval=$cApproval{$cand})\n" if ($verbose >= VERBOSE_DETAILS);
			delete $cHopeful{$cand};
		}
	}
	quotaMeek($excess);		# set initial quota
	#
	#  main loop
	#
	while (1) {
		weightMeek($excess);	# calculate new weights
		$excess = voteMeek();	# add up votes
		print "\n$methodname: Round $rounds quota=$quota excess=$excess\n" if ($verbose >= VERBOSE_DETAILS);
		dumpMeek("Round #" . $rounds, $excess);
		#
		#  2.6. Look for winners
		#
		my $all0q = 1;
		my $action = 0;
		foreach $cand ( keys %cHopeful ) {	# for each hopeful candidate
			my $votes = $cMeekVotes{$cand};
			if (!round_eq($votes, 0) && !round_eq($votes, $quota)) {
				$all0q = 0;
				last;
			}
		}
		if ($all0q) {
			#
			#  2.6. Special case: each hopeful has either 0 or quota votes
			#
			my $lowcand;
			foreach $cand ( keys %cHopeful ) {	# for each hopeful candidate
				if (round_eq($cMeekVotes{$cand}, 0.0)) {
					print "  eliminate $cName{$cand} (0)\n" if ($verbose >= VERBOSE_DETAILS);
					delete $cHopeful{$cand};
					++$action;
				} elsif (round_eq($cMeekVotes{$cand}, $quota)) {
					delete $cHopeful{$cand};
					print "  provisionally elect $cName{$cand}\n" if ($verbose >= VERBOSE_DETAILS);
					$cElected{$cand} = 1;	# pending random exclusion
					$cMeekWeight{$cand} = 1.0;	# initial weight
					++$action;
					if (!$lowcand)  {
						$lowcand = $cand;
					} elsif ( $cRandom{$cand} < $cRandom{$lowcand} ) {
						$lowcand = $cand;
					}
				}
			}
			#
			#  Extension: don't exclude unless too many elected
			#             (2.6 assumes Droop)
			#
			if ($lowcand && keys(%cElected) > $seats) {
				print "  eliminate $cName{$lowcand} (random)\n" if ($verbose >= VERBOSE_DETAILS);
				delete $cElected{$lowcand};	# randomly exclude one candidate
				delete $cMeekWeight{$lowcand};
				++$action;
			}
		} else {
			#
			#  2.6. Elect all candidates achieving quota
			#
			#  We elect one at a time, so that we don't elect too many candidates.
			#  That could happen if the quota is set too low (override) or because of rounding.
			#
			my $highcand;
			foreach $cand ( keys %cHopeful ) {	# for each hopeful candidate
				if (!defined($highcand) || round_gt($cMeekVotes{$cand}, $cMeekVotes{$highcand})) {
					$highcand = $cand;
				}
			}
			#
			#  Extension: defer election of candidates with exactly a quota,
			#  to preserve Droop Proportionality Criterions (DPC)
			#
			if (defined($highcand) && round_gt($cMeekVotes{$highcand}, $quota)) {
					print "  elect $cName{$highcand} ($cMeekVotes{$highcand})\n" if ($verbose >= VERBOSE_DETAILS);
					delete $cHopeful{$highcand};
					$cElected{$highcand} = 1;
					$cMeekWeight{$highcand} = 1.0;
					++$action;
			}
		}
		#
		#  2.6. If no action (elimination or election) taken,
		#  eliminate candidate with lowest vote. Break ties randomly.
		#
		if (!$action && (keys(%cElected)+keys(%cHopeful)) > $seats) {
			my $lowcand;
			my $tiebreak = "vote";
			foreach $cand ( keys %cHopeful ) {	# for each hopeful candidate
				if (!$lowcand) {
					$lowcand = $cand;
				} else {
					if (round_lt($cMeekVotes{$cand}, $cMeekVotes{$lowcand})) {
						$lowcand = $cand;
						$tiebreak = "vote";
					} elsif (round_eq($cMeekVotes{$cand}, $cMeekVotes{$lowcand})) {
						if ($cRandom{$cand} < $cRandom{$lowcand}) {
							$lowcand = $cand;
						}
						$tiebreak = "random";
					}
				}
			}
			if ($lowcand) {
				print "  eliminate $cName{$lowcand} ($tiebreak: $cMeekVotes{$lowcand})\n" if ($verbose >= VERBOSE_DETAILS);
				delete $cHopeful{$lowcand};
				++$action;
			}
		}
		#
		#  If (elected + hopefuls) <= seats,
		#    eliminate low-vote hopeful if < minimum quota
		#    else elect high-vote hopeful if >= minimum quota
		#
		#  This logic is not explictly shown in the Specification,
		#  but follows the Pascal procedure "complete", extended to support
		#  an optional minimum quota.
		#
		if (!$action && (keys(%cElected) + keys(%cHopeful)) <= $seats) {
			my $lowcand;
			my $highcand;
			my $lowbreak = "vote";
			my $highbreak = "vote";
			foreach $cand ( keys %cHopeful ) {	# for each hopeful candidate
				if (!$lowcand) {
					$lowcand = $cand;
				} else {
					if (round_lt($cMeekVotes{$cand}, $cMeekVotes{$lowcand})) {
						$lowcand = $cand;
						$lowbreak = "vote";
					} elsif (round_eq($cMeekVotes{$cand}, $cMeekVotes{$lowcand})) {
						if ($cRandom{$cand} < $cRandom{$lowcand}) {
							$lowcand = $cand;
						}
						$lowbreak = "random";
					}
				}
				if (!$highcand) {
					$highcand = $cand;
				} else {
					if (round_gt($cMeekVotes{$cand}, $cMeekVotes{$highcand})) {
						$highcand = $cand;
						$highbreak = "vote";
					} elsif (round_eq($cMeekVotes{$cand}, $cMeekVotes{$highcand})) {
						if ($cRandom{$cand} < $cRandom{$highcand}) {
							$highcand = $cand;
						}
						$highbreak = "random";
					}
				}
			}
			if ($lowcand && $highcand) {
				if (round_lt($cMeekVotes{$lowcand}, $minQuota)) {
					print "  eliminate $cName{$lowcand} ($lowbreak: $cMeekVotes{$lowcand})\n" if ($verbose >= VERBOSE_DETAILS);
					delete $cHopeful{$lowcand};
					++$action;
				} elsif (round_ge($cMeekVotes{$highcand}, $minQuota)) {
					print "  elect (fill) $cName{$highcand} ($highbreak: $cMeekVotes{$highcand})\n" if ($verbose >= VERBOSE_DETAILS);
					delete $cHopeful{$highcand};
					$cElected{$highcand} = 1;
					$cMeekWeight{$highcand} = 1.0;
					++$action;
				}
			}
		}

		#
		#  We're done if all the seats are filled,
		#  or if there are no hopeful candidates left.
		#
		$excess = voteMeek();	# add up votes after transfers
		dumpMeek("Round #$rounds after action", $excess);
		last if (keys(%cElected) >= $seats || keys(%cHopeful) == 0);
		++$rounds;
	}
	#
	#  Eliminate unelected hopefuls
	#
	foreach $cand ( keys %cHopeful ) {	# for each hopeful candidate
		delete $cHopeful{$cand};
		print "  eliminate remaining $cName{$cand} ($cMeekVotes{$cand})\n" if ($verbose >= VERBOSE_DETAILS);
	}
	print "Maximum $methodname iterations=$maxMeekIterations\n" if ($verbose >= VERBOSE_DETAILS);
} # sub methodMeek()

#  Set Meek/Warren quota
#  2.5
#  support optional lower limit on quota
#
sub quotaMeek {
	my $excess = $_[0];

	$quota = $quotaSet ? $quotaSet : ($nballots - $excess) / $quotaDiv;
	$quota = $minQuota if ($quota < $minQuota);
} # sub quotaMeek()

#  Add up votes in current round
#  2.4
#
sub voteMeek {
	my $excess = 0.0;
	my $cand;

	foreach $cand ( keys %cName ) {	# for each candidate
		$cMeekVotes{$cand} = 0.0;
	}
	foreach my $ballot ( @ballots ) {
		my $votes = $ballot->{ PREFS };	# array of ranked preferences
		my $ballotweight = $ballot->{ MULT };	# each ballot has a weight of MULT votes
		#
		#  scan ballot and assign votes
		#
		for (my $rank = 0; defined($votes->[$rank]); ++$rank) {
			$cand = $votes->[$rank];	# candidate at this rank
			#
			#  Meek: each elected candidate gets a fraction of the remaining vote.
			#  Warren: each elected candidate gets their fraction of the vote
			#          until it runs out.
			#
			if ( $cElected{$cand} ) {
				if ($method == METHOD_MEEK) {
					$cMeekVotes{$cand} += $ballotweight * $cMeekWeight{$cand};
					$ballotweight *= (1.0 - $cMeekWeight{$cand});
				} elsif ($method == METHOD_WARREN) {
					my $wvote = $cMeekWeight{$cand} * $ballot->{ MULT };
					$wvote = $ballotweight if ($ballotweight < $wvote);
					$cMeekVotes{$cand} += $wvote;
					$ballotweight -= $wvote;
				}
			#
			#  the first hopeful candidate gets the remainder
			#
			} elsif ( $cHopeful{$cand} ) {
				$cMeekVotes{$cand} += $ballotweight;
				$ballotweight = 0.0;
				last;
			}
		}
		$excess += $ballotweight;	# accumulate excess (exhausted) vote
	}
	return $excess;
} # sub voteMeek()

#  Calculate Meek/Warren weights for curent round
#  2.9
#
sub weightMeek {
	my $excess = $_[0];
	my $cand;
	my $done = 0;
	my $iters = 0;

	while (!$done) {
		quotaMeek($excess);		# calculate new quota
		foreach $cand ( keys %cElected ) {	# for each elected candidate
			$cMeekWeight{$cand} = ($cMeekWeight{$cand} * $quota) / $cMeekVotes{$cand};
		}
		$done = 1;
		$excess = voteMeek();
		foreach $cand ( keys %cElected ) {	# for each elected candidate
			if (!round_eq($quota / $cMeekVotes{$cand}, 1.0)) {
				$done = 0;
				last;
			}
		}
		if (++$iters > 100) {
			warning("weightMeek: iteration loop broken");
			last;
		}
	}
	$maxMeekIterations = $iters if ( $iters > $maxMeekIterations);
	quotaMeek($excess);		# calculate final quota for current round
} # weightMeek()

# dumpMeek(label, excess)
# DUMP Meek/Warren data structures
#
sub dumpMeek {
	return if ( $verbose < VERBOSE_DUMP );
	my ($msg, $excess) = @_;		# label for printing
	my $cand;
	my $total = 0.0;
	my $votes;

	print "\nDUMP " . $msg . "\n" if ($verbose >= VERBOSE_DUMPALL);

	foreach $cand ( keys %cName ) {
		if ( $cElected{$cand} ) {
			my $xfr = round(1.0 - $cMeekWeight{$cand});
			$votes = round($cMeekVotes{$cand});
			print "Elected: $cand: $cName{$cand} $votes $xfr\n" if ($verbose >= VERBOSE_DUMPALL);
			$total += $cMeekVotes{$cand};
		}
	}
	foreach $cand ( keys %cName ) {
		if ( $cHopeful{$cand} ) {
			$votes = round($cMeekVotes{$cand});
			print "Hopeful: $cand: $cName{$cand} $votes\n" if ($verbose >= VERBOSE_DUMPALL);
			$total += $cMeekVotes{$cand};
		}
	}
	foreach $cand ( keys %cName ) {
		if ( !$cElected{$cand} && !$cHopeful{$cand} ) {
			$votes = round($cMeekVotes{$cand});
			print "Eliminated: $cand: $cName{$cand} $votes\n" if ($verbose >= VERBOSE_DUMPALL);
			$total += $cMeekVotes{$cand};
		}
	}
	print "  Check votes: votes=" . round($total) . " + excess=" . round($excess) . " = " . round($total + $excess) . " / " . $nballots . " ballots\n\n";
} # sub dumpMeek

#	Depending on the setting of parameters, this implements the
#   British Columbia method of STV,
#	except that tie-breaking is always random.
#
#   The method is described here: http://www.fairvote.org/consulting/fractional.htm
#   (but with an integral quota).
#
sub methodBC {
	my $cand;

	if ($minQuota && $minQuota != $quota) {
		fatal("Method BC: minimum quota $minQuota not supported; turn off Hare2/Droop2");
	}
		%cElected = ();
		%cHopeful = ();
		foreach $cand ( keys %cName ) {
			$cResidualApproval{ $cand } = 0.0;
			$cHopeful{ $cand } = 1 if ( !$cWithdrawn{ $cand } );
		}

	#  Do the rounds.
	#
	#  1. Find the active candidate with the highest number of votes.
	#     tie breaker: random
	#     1a. If no candidates, we're done.
	#
	#  2. If result of #1 > quota, mark candidate elected
	#     and distribute (pro rata) excess votes to next-place choices.
	#     2a. If all seats filled, we're done.
	#     2b. Otherwise go back to step 1.
	#
	#  3. If any candidates with residual approval <= mandatory quota,
	#     4a. Eliminate candidates as hopeless
	#     4b. Distribute votes to next-place choices on each ballot
	#     4c. Go to step 1
	#
	#  4. Find active candidate with fewest votes.
	#     tie breakers as in step 1
	#     4a. Eliminate candidate
	#     4b. Distribute votes to next-place choices on each ballot
	#     4c. Go to step 1
	#  
	#  Notes.
	#     Count exhausted ballots for use in check-total.
	#     Check-total after each round is:
	#        weight of votes for active candidates
	#          (active means not elected and not eliminated)
	#        plus weight of exhausted ballots
	#        plus number of elected candidates times quota
	#     Check-total should be equal to total votes cast
	#        (within precision of our arithmetic)
	#
	%cPiles = ();
	foreach my $ballot ( @ballots ) {
		my $index = 0;
		my $votes = $ballot->{ PREFS };
		#
		#  First skip any withdrawn (non-hopeful) candidates.
		#
		while (1) {
			last if ( !defined($votes->[$index]) );
			last if ( $cHopeful{$votes->[$index]} );
			$index += 1;
		}
		$ballot->{ INDEX } = $index;
		$ballot->{ WEIGHT } = 1.0;
		#
		#  Then push the ballot onto the pile for its first-choice hopeful candidate.
		#
		if ( defined($votes->[$ballot->{ INDEX }]) ) {
			push @{$cPiles{$votes->[$ballot->{ INDEX }]}}, $ballot;
		} else {
			++$exhausted;
		}
	}

	$rounds = 0;
	ROUND: while (1) {
		my $cand;

		++$rounds;
		print "\nRound " . $rounds . "\n" if ($verbose >= VERBOSE_DETAILS);
		#
		#  Calculate residual approval for each remaining candidate.
		#
		foreach $cand ( keys %cName ) {
			$cResidualApproval{$cand} = 0.0;
		}
		foreach $cand ( keys %cHopeful ) {
			my $ballot;
			my $pile = $cPiles{$cand};		# ballots choosing this candidate
			foreach $ballot ( @$pile ) {
				my $index = $ballot->{ INDEX };
				my $votes = $ballot->{ PREFS };
				while ( defined($votes->[ $index ]) ) {
					$cResidualApproval{ $votes->[ $index ] } += $ballot->{ WEIGHT } * $ballot->{ MULT };
					++$index;
				}
			}
		}

		#
		#  Find remaining candidate with highest vote.
		#
		my $highcand;
		my $highvote = 0.0;
		my $tiebreak = "vote";
		foreach $cand ( keys %cHopeful ) {		# for each hopeful candidate
			my $vote = 0.0;
			my $ballot;
			my $pile = $cPiles{$cand};		# ballots choosing this candidate
			foreach $ballot ( @$pile ) {
				$vote += $ballot->{ WEIGHT } * $ballot->{ MULT };	# vote weight
			}
			if ($verbose >= VERBOSE_DETAILS) {
				print "Hopeful: " . $cName{$cand} . " (" . round($vote) . ")\n";
			}
			#
			#  Update high-vote candidate
			#
			if ( !$highcand ) {
				$highcand = $cand;
				$highvote = $vote;
				$tiebreak = "vote";
			} elsif ( round_gt($vote, $highvote) ) {
				$highcand = $cand;
				$highvote = $vote;
				$tiebreak = "vote";
			} elsif ( round_eq($vote, $highvote) ) {
				#
				#  break ties with coin toss
				#
				$tiebreak = "random";
				if ( $cRandom{$cand} > $cRandom{$highcand} ) {
					$highcand = $cand;
					$highvote = $vote;
				}
			}
		}

		#
		#  If there are no more hopeful candidates, we're done.
		#
		print "Hopeful candidates: " . scalar(keys(%cHopeful)) . "\n" if ($verbose >= VERBOSE_DETAILS);
		last if ( keys(%cHopeful) == 0 );

		#
		#  Otherwise print the high-vote candidate and indicate whether s/he crossed the quota.
		#
		if ($verbose >= VERBOSE_DETAILS) {
			print "High: " . $cName{$highcand} . " " . $highvote . " (" . $tiebreak . ")";
			print (($highvote > $quota) ? " (elected)\n" : " (not elected)\n");
		}

		#
		#  If the high-vote candidate crossed the quota, we've filled a seat.
		#
		if ( $highvote > $quota ) {
			$cElected{$highcand} = 1;		# mark as elected
			delete($cHopeful{$highcand});	# no longer hopeful
			#
			#  Distribute excess votes
			#  Each ballot goes to the next candidate on the ballot,
			#  with the ballot weight reduced according to the excess vote.
			#
			my $excess = $highvote - $quota;
			if ( $excess > 0.0 ) {
				my $pile = $cPiles{$highcand};
				my $ballot;
				#
				#  Distribute each ballot in the elected candidate's pile.
				#
				foreach $ballot ( @$pile ) {
					next if ( $ballot->{ WEIGHT } <= 0.0 );	# possible? maybe not.
					$ballot->{ WEIGHT } *= $excess / $highvote;	# reduce ballot weight
					my $prefs = $ballot->{ PREFS };
					#
					#  Find the next-place choice for this ballot.
					#  If no more choices, add to exhausted count for bookkeeping.
					#
					while (1) {
						$ballot->{ INDEX } += 1;
						if (defined( $prefs->[ $ballot->{ INDEX } ]) ) {
							# transfer ballot to next choice
							my $nextcand = $prefs->[ $ballot->{ INDEX } ];
							next if ( !$cHopeful{$nextcand} );
							push @{$cPiles{$nextcand}}, { %$ballot };
						} else {
							# ballot is exhausted
							$exhausted += $ballot->{ WEIGHT } * $ballot->{ MULT };
						}
						last;
					}
				}
			}
			dumpBC( "round" );	# debug prints
			#
			#  Done if we've filled all the seats.
			#
			last if ( keys(%cElected) >= $seats );
			#
			#  Otherwise do another round.
			#
			next ROUND;
		}
		#
		#  No winner in this round.
		#    See if we're finished.
		#    If mandatory quota, eliminate candidates with residual approval <= quota
		#    Find & eliminate remaining hopeful candidate with lowest vote.
		#
		if ( $mandatoryQuota ) {
			#
			#  If we're using a mandatory quota, there's only one candidate left,
			#  and that candidate hasn't crossed the quota, we're done.
			#
			last if ( keys(%cHopeful) == 1 && $highvote <= $quota );
		} else {
			#
			#  Otherwise we can elect all the remaining hopefuls if the number of seats permits.
			#
			last if ( (keys(%cHopeful) + keys(%cElected)) <= $seats );
		}

		#
		#  If mandatory quota, eliminate hopeless candidates with residual approval <= quota
		#
		if ( $mandatoryQuota) {
			my $nelim = 0;
			foreach $cand ( keys %cName ) {			# for each candidate
				next if ( !$cHopeful{$cand} );		# hopeful candidates only
				#
				# eliminate as hopeless if residual approval doesn't pass quota
				#
				if (round_ge($quota, $cResidualApproval{$cand})) {
					#
					#  Distribute the candidate's votes
					#
					print "Hopeless: " . $cName{$cand} . " (" . $cResidualApproval{$cand} . ") (eliminated)\n" if ($verbose >= VERBOSE_DETAILS);
					delete($cHopeful{$cand});	# abandon hope
					++$nelim;
					my $pile = $cPiles{$cand};
					my $ballot;
					foreach $ballot ( @$pile ) {
						next if ( $ballot->{ WEIGHT } <= 0.0 );
						my $prefs = $ballot->{ PREFS };
						while (1) {
							$ballot->{ INDEX } += 1;
							if (defined( $prefs->[ $ballot->{ INDEX } ]) ) {
								# transfer ballot to next choice
								my $nextcand = $prefs->[ $ballot->{ INDEX } ];
								next if ( !$cHopeful{$nextcand} );	# distribute only to hopeful candidates
								push @{$cPiles{$nextcand}}, { %$ballot };
							} else {
								# ballot is exhausted
								$exhausted += $ballot->{ WEIGHT } * $ballot->{ MULT };
							}
							last;
						}
					}
				}
			}
			if ($nelim > 0) {
				dumpBC( "round" );	# debug prints
				next ROUND;
			}
		}

		#
		#  Find a candidate to eliminate.
		#
		my $lowvote = $nballots + 1.0;
		my $lowcand;
		$tiebreak = "vote";
		foreach $cand ( keys %cName ) {			# for each candidate
			next if ( !$cHopeful{$cand} );		# hopeful candidates only
			my $vote = 0.0;
			my $ballot;
			my $pile = $cPiles{$cand};
			foreach $ballot ( @$pile ) {
				$vote += $ballot->{ WEIGHT } * $ballot->{ MULT };	# vote weight for this candidate
			}
			#
			#  Find low vote of remaining candidates.
			#
			if ( !$lowcand ) {
				$lowcand = $cand;
				$lowvote = $vote;
				$tiebreak = "vote";
			} elsif ( round_lt($vote, $lowvote) ) {
				$lowcand = $cand;
				$lowvote = $vote;
				$tiebreak = "vote";
			} elsif ( round_eq($vote, $lowvote) ) {
				#
				#  break ties with coin toss
				#
				$tiebreak = "random";
				if ( $cRandom{$cand} < $cRandom{$lowcand} ) {
					$lowcand = $cand;
					$lowvote = $vote;
				}
			}
		}
		#
		#  Eliminate lowest candidate
		#  Distribute that candidate's votes
		#
		print "Low: " . $cName{$lowcand} . " " . $lowvote . " (" . $tiebreak . ") (eliminated)\n" if ($verbose >= VERBOSE_DETAILS);
		delete($cHopeful{$lowcand});	# abandon hope
		my $pile = $cPiles{$lowcand};
		my $ballot;
		foreach $ballot ( @$pile ) {
			next if ( $ballot->{ WEIGHT } == 0 );
			my $prefs = $ballot->{ PREFS };
			while (1) {
				$ballot->{ INDEX } += 1;
				if (defined( $prefs->[ $ballot->{ INDEX } ]) ) {
					# transfer ballot to next choice
					my $nextcand = $prefs->[ $ballot->{ INDEX } ];
					next if ( !$cHopeful{$nextcand} );	# distribute only to hopeful candidates
					push @{$cPiles{$nextcand}}, { %$ballot };
				} else {
					# ballot is exhausted
					$exhausted += $ballot->{ WEIGHT } * $ballot->{ MULT };
				}
				last;
			}
		}
		dumpBC( "round" );
		# implicit next ROUND;
	} # ROUND
	#
	#  Elect or eliminate unelected hopefuls
	#
	foreach my $cand ( keys %cHopeful ) {	# for each hopeful candidate
		delete $cHopeful{$cand};
		if ( $mandatoryQuota || keys(%cElected) >= $seats ) {
			print "Eliminate remaining: $cName{$cand}\n" if ($verbose >= VERBOSE_DETAILS);
		} else {
			$cElected{$cand} = 1;		# mark as elected
			print "Elect remaining: $cName{$cand}\n" if ($verbose >= VERBOSE_DETAILS);
		}
	}

} # sub methodBC()

# dumpBC(label)
# DUMP BC data structures
#
sub dumpBC {
	return if ( $verbose < VERBOSE_DUMP );
	my ($msg) = @_;		# label for printing
	my $cand;
	my $pile;
	my $ballot;
	my $prefs;
	my $vote;
	my $left = 0.0;
	my $total = 0.0;
	print "\nDUMP " . $msg . "\n" if ($verbose >= VERBOSE_DUMPALL);
	foreach $cand ( keys %cName ) {
		print "CAND: " . $cand . ": " . $cName{$cand} if ($verbose >= VERBOSE_DUMPALL);
		if ( $cElected{$cand} ) {
			$total += $quota;
			print " elected\n" if ($verbose >= VERBOSE_DUMPALL);
			next;
		} elsif ( !$cHopeful{$cand} ) {
			print " eliminated\n" if ($verbose >= VERBOSE_DUMPALL);
			next;
		}
		print "\n" if ($verbose >= VERBOSE_DUMPALL);
		$pile = $cPiles{$cand};
		foreach $ballot ( @$pile ) {
			$left += $ballot->{ WEIGHT } * $ballot->{ MULT };
			print " ballot index=" . $ballot->{ INDEX } if ($verbose >= VERBOSE_DUMPALL);
			print " weight=" . $ballot->{ WEIGHT } if ($verbose >= VERBOSE_DUMPALL);
			print " multiple=" . $ballot->{ MULT } if ($verbose >= VERBOSE_DUMPALL);
			$prefs = $ballot->{ PREFS };
			foreach $vote ( @$prefs ) {
				print " " . $vote if ($verbose >= VERBOSE_DUMPALL);
			}
			print "\n" if ($verbose >= VERBOSE_DUMPALL);
		}
		print " approval: " . $cApproval{$cand} . "\n" if ($verbose >= VERBOSE_DUMPALL);
		print " residual approval: " . $cResidualApproval{$cand} . "\n" if ($verbose >= VERBOSE_DUMPALL);
	}
	print "Check votes: elected=" . $total . " + exhausted=" . $exhausted . " + left=" . $left . " = " . ($total + $left + $exhausted) . " / " . $nballots . " ballots\n";
} # sub dumpBC()

#  methodBLT()
#  Create .blt file for OpenSTV
#
sub methodBLT {
	my $cand;
	my $blt = 0;
	my %cBLT = ();		# blt candidate number
	my $candidates = keys(%cName);
	my $ballot;

	printf $resultsfile "$candidates $seats\n";
	foreach $cand ( keys %cName ) {	# for each candidate
		++$blt;
		$cBLT{$cand} = $blt;
	}
	foreach $cand ( keys %cWithdrawn ) {	# for each withdrawn candidate
		print $resultsfile "-$cBLT{$cand}\n";
	}
	foreach $ballot ( @ballots ) {
		print $resultsfile "1";
		my $index = $ballot->{ INDEX };
		my $votes = $ballot->{ PREFS };
		while ( defined($votes->[ $index ]) ) {
			print $resultsfile " " . $cBLT{ $votes->[ $index ] };
			++$index;
		}
		print $resultsfile " 0\n";	# end of this ballot
	}
	print $resultsfile "0\n";	# end of ballots
	foreach $cand ( keys %cName ) {	# for each candidate
		print $resultsfile "\"" . $cName{$cand} . "\"\n";
	}
	print $resultsfile "\"$title\"\n";
} # sub methodBLT()

sub warning {
	my ($msg) = @_;

	print "WARNING: $msg\n" if ($verbose >= VERBOSE_WARNINGS);
	push @warnings, $msg;	# publish warnings for caller

} # sub warning()

sub fatal {
	my ($msg) = @_;

	print "FATAL: $msg\n";
	die "$msg";

} # sub fatal()

#  sub round($val)
#
#  return $val rounded to $precision decimal places
#  shortcut: depends on fact that $val is fairly close to 1.
#
{
my $round_factor;

sub round {
	my ($val) = @_;
	my $sign;

	$round_factor = 10.0 ** $precision if not defined($round_factor);
	if ($val < 0) {
		$sign = -1;
		$val = -$val;
	} else {
		$sign = 1;
	}
	return $sign * (floor($val * $round_factor + 0.5) / $round_factor);
} # sub round()
}

#  rounded comparisons
#
sub round_eq {
	my ($a, $b) = @_;
	return round($a - $b) == 0.0;
} # sub round_eq()

sub round_gt {
	my ($a, $b) = @_;
	return round($a - $b) > 0.0;
} # sub round_gt()

sub round_ge {
	my ($a, $b) = @_;
	return round($a - $b) >= 0.0;
} # sub round_ge()

sub round_lt {
	my ($a, $b) = @_;
	return round($a - $b) < 0.0;
} # sub round_lt()

#  portable random number generator
#
#  After Knuth, Seminumerical Algorithms 2ed, 3.6
#
#  Use an RNG that will be determinate across most platforms.
#  We assume a 32-bit integer; that's about all.
{
use integer;

my ($X, $a, $c, $m);

sub rng_init {
	$X = int($seed + $totalApproval);
	$a = 3141592621;		# $a mod 8 should be 5
	$c = $a;
	$m = 0xffffffff;		# 2^32 - 1
	rng(); rng(); rng();	# mix us up a bit
	return;
} # sub rng_init

sub rng {
	$X = ($a * $X + $c) & $m;
	return $X;
}
}

1;