#!/usr/bin/perl

# See README for licensing information.

# Copyright 2006 Andrew C. Myers
# Copyright 2006 Alexandre Oliva

# This is a non-web-based minimally-stripped-down version of CIVS,
# available from http://www.cs.cornell.edu/andru/civs.html.

# This file was adapted from civs-2.4.tar.gz's cgi-bin/results by
# Alexandre Oliva <lxoliva@fsfla.org> to run Condorcet/Schulze
# elections out of votes in textual input.  Output is still html.
# There are minimal changes to the few civs files copied over, to
# simplify updates.  This is why you'll see references to subs,
# variables and packages that are not present in this distribution.

# The modifications to this file are given by civs-2.4.patch.
# beatpath.pm, also copied from there, was not modified other than by
# the addition of a missing copyright notice and license information.


# Votes are of the form v1[>=]v2[>=]v3..., one per line, no blanks
# allowed, where each vn is a different nonnegative number.  a=b means
# a and b are equally preferable; a>b means a is preferable over b.
# Nothing is assumed about missing choices in votes (i.e., they are
# not considered less preferrable than explicitly-listed options.  You
# may use expand-vote.cc or something similar if you want them to be
# considered less preferable).  -1, if present, will be mapped to 0,
# but then no votes must be explicitly cast for 0, otherwise an error
# will ensue.

# The number of options is inferred from the input.  If there are
# higher-numbered options than those listed in any of the votes, the
# results won't take them into account.

use strict;
use warnings;

# use lib '@CGIBINDIR@';
# use admctrl;
# use civs_common;
use CGI qw(:standard);
use Socket;
use IO::Handle;
use POSIX qw(strftime);


use Digest::MD5 qw(md5_hex);
use DB_File;
use beatpath;
# use rp;

my $thisurl = '.';
my $thishost = 'localhost';
my $civs_url = '/no/such/url';
my $civs_bin_path = '.';
my $detailed = 1;
my $cr = "\n";

# CheckLoad;
# timeout(30);

# HTML_Header('CIVS Election Results', 'results.js');
# use election;

# CheckElectionID;
# CheckStarted;

# &UnlockElection;

# if ($public ne 'yes') {
#     CheckStopped;
# }

our $election_id = '';
our $title = 'Condorcet/Schulze Election results';
our $num_winners = 1;
our $num_choices = 0;
our $algorithm = 'beatpath_winner';
our $ballot_reporting = 'yes';
our $proportional = 'no';
our $use_combined_ratings = 0;
our $num_votes = 0;
our @choices = ();
our %vdata;

&ReadVotes;

our %vdata_copy = %vdata;

print h2($title);

# my $nwin_param = param('num_winners');
my $nwin_param = 1;
my $real_nwin = $num_winners;
if (defined($nwin_param) && $nwin_param > 0 &&
    $nwin_param < $num_choices) {
	$num_winners = 0+$nwin_param;
}
# my $algorithm = param('algorithm');
# if (!defined($algorithm) || $algorithm eq '')
# { $algorithm = 'beatpath_winner'; }

# my $real_prop = $proportional;
# my $show_prop = param('proportional');
# if (defined($show_prop) && $show_prop ne '') {
#     $proportional = $show_prop;
# }

# print '<form method="GET"
# 	action="'.$thisurl.'"
# 	enctype="multipart/form-data"
# 	name="changeSettings">';
# print escapeHTML("Election supervisor: $name ("), tt($email_addr).')', br();
# print "Announced end of election: $election_end", br();
# if (IsStopped) {
#     my $close_time = $vdata_copy{'close_time'};
#     print "Actual time election ended: $close_time", br();
# } else {
#     print 'Election has not yet ended.', br();
# }
# if ($public ne 'yes') {
#     print "Private election ($num_auth authorized voters)", br();
# } else {
#     print "This is a public poll.", br();
# }
print "Actual votes cast: $num_votes", br();

    print 'Number of winning choices: ';
    print '<input type="text" size=2
	    name="num_winners"
	    onChange="newSettings()"
	    value="'.$num_winners.'">';
    print hidden('id', $election_id);
    if ($real_nwin != $num_winners) {
	my $winmsg = '1 winner';
	if ($real_nwin != 1) {
	    $winmsg = $real_nwin.' winners';
	}
	print "&nbsp;(Election actually has $winmsg)";
    }

print br();
if ($proportional eq 'yes') {
    my $url = $civs_url.'/proportional.html';
    print "This election implements <a href=\"$url\">proportional representation</a>. ";
    if ($use_combined_ratings) {
	print " The <a
	href=\"$url#combinedratings\">combined-weights criterion</a>";
    } else {
	print " The <a href=\"$url#bestcandidate\">best-candidate criterion</a>";
    }
    print ' is used to identify each voter\'s preferred set of choices.'.br();
}
my $bw_checked = '';
my $rp_checked = '';
my $mam_checked = '';
if ($algorithm eq 'civs_ranked_pairs') {
    $rp_checked = 'checked';
} elsif ($algorithm eq 'mam') {
    $mam_checked = 'checked';
} else {
    $bw_checked = 'checked';
}

print STDOUT 'Condorcet completion rule:
    <input type="radio"
	name="algorithm"
	onClick="newSettings()"
	value="beatpath_winner" ',
	$bw_checked,
    '> Beatpath/Schulze/CSSD &nbsp;&nbsp;
    <input type="radio"
	name="algorithm",
	onClick="newSettings()"
	value="civs_ranked_pairs"',
	$rp_checked,
    '> CIVS Ranked Pairs &nbsp;&nbsp;
    <input type="radio"
	name="algorithm",
	onClick="newSettings()"
	value="mam"',
	$mam_checked,
    '> MAM';
    print '&nbsp;&nbsp;&nbsp; <a href="',$civs_url,'/rp.html">(What is this?)</a>';
    print '&nbsp;<input type="submit" id="recomplete" value="Update">';

  # print '&nbsp;<input type="submit" name="submit" value="Update display options">';
print '</form>',$cr;

# print h2('Election description'), p($description);

# These variables are global to the results computations.
my ($condorcet_winner);
my (@result, @matrix, @closure_matrix, @choice_index, @choice_rank);
my (%visited); 

&ComputeNonproportionalResults;   # needed regardless of the election type

if ($proportional eq 'yes') {
    &PrintProportionalResults;
} else { 
    &PrintCondorcetWinner;

    print h2("Ranking of the choices");

    if ($algorithm eq 'civs_ranked_pairs' ||
	$algorithm eq 'mam') {
	&PrintRP;
    } else {
	&PrintBW;
    }
    print hr();
    
    if ($detailed) {
	    &PrintNonproportionalDetails;
    } else {
	    my $details_url = "$thisurl?id=$election_id&num_winners=$num_winners&algorithm=$algorithm" .
		'&detailed=1#details';
	    my $link = a({-href=>"$details_url"}, "Detailed results") 
		    . " are also available.";
	    print p($link);
    }
}

print end_html();

exit 0;

# PrintMatrix(n, m, choices, choice_index, zerodot)
# generates HTML output for the n-by-n matrix m. The
# names of the choices are found in @choices, and
# order of the choices is defined by choice_index:
# choice_index[i] is the index of the i'th choice
# (in choices and m).
sub PrintMatrix {
    my $n = $_[0];
    my @m = @{$_[1]};
    my @choices = @{$_[2]};
    my @choice_index = @{$_[3]};
    my $zerodot = $_[4];

    print '<table class="matrix">'.$cr;
    print '<tr><td>&nbsp;</td><td>&nbsp;</td>';
    for (my $jj = 0; $jj < $n; $jj++) {
		my $j1 = $jj + 1;
		print '<th width=20px>'.$j1.'.</th>';
    }
    print '</tr>'.$cr;
    for (my $jj = 0; $jj < $n; $jj++) {
	my $j = $choice_index[$jj];
	my $j1 = $jj + 1;
	print '<tr>';
	print '<th align=left>'.$j1.'.&nbsp;'.$choices[$j].'</th>'.$cr;
	print "<td width=40px>&nbsp;</td>\n";
	for (my $kk = 0; $kk < $n; $kk++) {
	    my $k = $choice_index[$kk];
	if ($j == $k) {
		print '<td class="count">-';
	    } else {
		my $w = $m[$j][$k];
		my $l = $m[$k][$j];
		if ($w > $l) {
		    print "<td class=\"win\" title=\"$choices[$j] beats $choices[$k] $w&ndash;$l\">";
		} elsif ($w == $l) {
		    print "<td class=\"tie\" title=\"$choices[$j] ties $choices[$k] $w&ndash;$l\">";
		} else {
		    print "<td class=\"lose\" title=\"$choices[$j] loses to $choices[$k] $w&ndash;$l\">";
		}
		if ($zerodot && $w == 0) {
		    print '.';
		} else {
		    print $w;
		}
		print '</td>';
	    }
	}
	print '</tr>'.$cr;
    }
    print '</table>'.$cr;
}

sub PrintNonproportionalDetails {
# Print the detailed results of the ordinary
# (nonproportional) beatpath algorithm. 

    print h2("Detailed results");

    my $summary_url = "$thisurl?id=$election_id&num_winners=$num_winners";
    print p(&details_bookmark . a({-href=>"$summary_url"}, "Hide details"));
	
    my ($j, $jj, $k, $kk);
    print h2("Beatpath closure matrix");
    print p("
    The following matrix shows the strength of the strongest
    beatpath connecting each pair of choices. Choice 1 is preferred
    to choice 2 if there is a better beatpath leading from 1 to 2
    than any leading from 2 to 1.
    ");

    PrintMatrix $num_choices, [@closure_matrix], [@choices], [@choice_index], 1;

    print h2('Ballot report');

    if ($ballot_reporting eq 'yes') {
		my @voters = split /\n/, $vdata_copy{'recorded_voters'};
		if ($#voters >= 0) {
			my @headings = @choices;
			my @rows = th({-width=>'40px'}, '&nbsp;') . th(\@headings);

			my $i = 1;

			fisher_yates_shuffle(\@voters);  # permute @voters to improve anonymity
			foreach my $voter_key (@voters) {
		    	# recorded_vote is a comma separated list of the ranks
			    # that the voter assigned to candidates.  Element i of the list
			    # corresponds to candidate i.
			    my $recorded_vote = $vdata_copy{$voter_key}; 
		    	my @row = split /,/, $recorded_vote;
			    unshift @row, "$i. ";
			    $i++;
			    push @rows, td(\@row);
			}

			print table({-class=>'matrix'},
				Tr(\@rows));
			# print p("Ballots are shown in a randomly generated order.");
			# print p(a({-href=>"http://$thishost$civs_bin_path/download_ballots?id=$election_id"},"Download ballots") . " as a CSV.");
        } else {
			print p("No ballots were cast in this election.");
		}
    } else {
		print p("Detailed ballot reporting is not enabled for this election.");
    }
}

sub ComputeNonproportionalResults {
	# Compute condorcet winner and set up $matrix and $beatpath
	$condorcet_winner = -1;
	for (my $j = 0; $j < $num_choices; $j++) {
	    if ($condorcet_winner < 0) { $condorcet_winner = $j; }
	    for (my $k = 0; $k < $num_choices; $k++) {
			my $n; $n = $vdata_copy{"$j.$k"} or $n = 0;
			$matrix[$j][$k] = $n;
			if ($j != $k) {
			    my $m; $m = $vdata_copy{"$k.$j"} or $m = 0;
			    if ($n <= $m && $condorcet_winner == $j) {
					$condorcet_winner = -1; # can't be this one
			    }
			}
	    }
	}

	$beatpath::n = $num_choices;
	for (my $j = 0; $j < $num_choices; $j++) {
	    for (my $k = 0; $k < $num_choices; $k++) {
			$beatpath::matrix[$j][$k] = $matrix[$j][$k];
	    }
	}
	&beatpath::rank_candidates();
	@result = @beatpath::result;
	@closure_matrix = @beatpath::closure_matrix;
	@choice_index = @beatpath::choice_index;
}

sub PrintRanking {
    my @result = @{$_[0]};
    my @matrix = @{$_[1]};
    my $had_tie = 0;
    print '<table class="rankings">';
    my $j = 0;
    my $num_seen = 0;
    for (my $rank = 0; $rank <= $#result; $rank++) {
	my @winner = @{$result[$rank]};
	# find the explanatory defeat
	print '<tr><td>'.($j+1).'. ';
	my $ranksize = $#winner + 1;
	if ($ranksize > 1) {
	    print '<i>Tied</i>:<br>';
	}
	    my $tie;
	if ($num_seen < $num_winners &&
	    $num_seen + $ranksize > $num_winners) {
	    $tie = 1;
	    $had_tie = 1;
	} else {
	    $tie = 0;
	}
# A bit torn on whether to escapeHTML() the names of the
# candidates here. What about writeins, especially on a
# public election?
	for (my $i = 0; $i <= $#winner; $i++) {
	    if ($i > 0) { print '<br>'; }
	    if ($tie) { print '<font color=red>'; }
	    my $explanation = '';
	    if ($rank > 0) {
		for (my $brank = $rank-1; $brank >= 0; $brank--) {
		    my @pwinners = @{$result[$brank]};
		    for (my $bi = 0; $bi <= $#pwinners; $bi++) {
			if ($matrix[$pwinners[$bi]][$winner[$i]] >
			    $matrix[$winner[$i]][$pwinners[$bi]] &&
			    $pwinners[$bi] != $condorcet_winner) {
			    $explanation =
				', loses to '.
				$choices[$pwinners[$bi]].' by '.
				$matrix[$pwinners[$bi]][$winner[$i]].'&ndash;'.
				$matrix[$winner[$i]][$pwinners[$bi]];
			    $brank = -1; last;
			}
		    }
		}
	    } else {
		$explanation = '';
	    }
	    if (0 && $explanation ne '') {
		print '<span title="',$explanation,'">';
	    }
	    if ($num_seen < $num_winners) {
		print b($choices[$winner[$i]]);
	    } else {
		print $choices[$winner[$i]];
	    }
	    if ($condorcet_winner != -1 &&
		$condorcet_winner != $winner[$i]) {
		print '<span class=explain>&nbsp;&nbsp;loses ';
		print ' to '.$choices[$condorcet_winner].' by ';
		print $matrix[$condorcet_winner][$winner[$i]].'&ndash;'.
			    $matrix[$winner[$i]][$condorcet_winner];
		print '</span>';
	    }
	    if ($explanation ne '') {
		print '<span class=explain>'.$explanation.'</span>';
	    }
	    $choice_rank[$winner[$i]] = $j++;
	    if (0 && $explanation ne '') {
		print '</span>';
	    }
	    if ($tie) { print '</font>'; }
	}
	$num_seen += $#winner + 1;
	print '</td></tr>';
    }
    print '</table>';
    if ($had_tie) {
	print p("Choices shown in red have tied for being selected.
		You may wish to select among them randomly.");
    }
}

sub PrintCondorcetWinner {
# this is common to all Condorcet methods
    if ($proportional ne 'yes') {
	print h2("Condorcet winner");
	if ($condorcet_winner >= 0) {
		    print p('The Condorcet winner of this election is '.
			    strong($choices[$condorcet_winner]).'.');
	} else {
		    print p('This election had no Condorcet winner.').$cr;
	}
    }
}

sub PrintBW {
	PrintRanking [@result], [@matrix];

	print h2("Preference matrix");
	print p("The following table shows the results of all
	pairwise contests between
	two choices. Each entry shows the number of ballots on
	which one choice was preferred to another choice.");
	PrintMatrix $num_choices, [@matrix], [@choices], [@choice_index], 0;
}

sub details_bookmark {
	return a({-name=>"details"}, "");
}

sub PrintRP {
	STDOUT->flush();

	if ($algorithm eq 'mam') {
	    $rp::mam = 1;
	    my @voters = split /\n/, $vdata_copy{'recorded_voters'};
	    my @ballots = ();
# generate a consistent random seed
	    srand(hex(substr($election_id, length($election_id) - 8)));
	    fisher_yates_shuffle(\@voters);
	    foreach my $voter_key (@voters) {
		my $ballot = $vdata_copy{$voter_key}; 
		push @ballots, $ballot;
	    }
	    &rp::create_RVH(\@ballots, $num_choices);
	} else {
	    $rp::mam = 0;
	}
        (my $rref, my $ciref, my $denied_any,
	 my $allowed_cycle, my $denied_report) = 
	    &rp::rank_candidates([@matrix], $num_choices, [@choices]);
	#print pre("Done ranking");

	PrintRanking $rref, [@matrix];

	print h2("Preference matrix");
	print p("The following table shows the results of all
	pairwise contests between
	two choices. Each entry shows the number of ballots on
	which one choice was preferred to another choice.");
	PrintMatrix $num_choices, [@matrix], [@choices], $ciref, 0;

	if (!$allowed_cycle && !$denied_any) {
	    print p('All preferences were affirmed. All
	    Condorcet election methods will
	    agree with this ranking.');
	}
	if ($denied_any) {
	    # print $denied_report;
	    print p('The presence of a green entry below
	    the diagonal (and a corresponding red one above)
	    means that a preference was ignored because
	    it conflicted with other, stronger preferences.');
	}
	if ($algorithm eq 'mam') {
	    if (0) { # don't warn on single-use of $rp::tiebreak) {
		print p('Random tie breaking was used to
		arrive at this ordering, as per the MAM
		algorithm. This may have affected the ordering
		of the choices.');
	    } else {
		print p('No random tie breaking was needed to
		arrive at this ordering.');
	    }
	}

}

############################################################
# Proportional Results
############################################################

no strict;
no warnings;

our %visited;

sub PrintProportionalResults {
# first sort the choices by the ordinary election algorithm
    @voter_keys = split /[\r\n]+/, $recorded_voters;
    for (my $j = 0; $j < $num_choices; $j++) {
	$choice_index[$j] = $j;
	for (my $k = 0; $k < $j; $k++) {
	    my $sjk = 0;
	    my $skj = 0;
	    for (my $v = 0; $v < $num_votes; $v++) {
		my $voter_key = $voter_keys[$v];
		my $ratings = $vdata_copy{$voter_key};
		my @ratings = split /,/, $ratings;
		my $wj = $ratings[$j];
		my $wk = $ratings[$k];
		if ($real_prop ne 'yes') {
		    $wj = $num_choices - $wj;
		    $wk = $num_choices - $wk;
		}
		if ($wj > $wk) { $sjk++; }
		if ($wk > $wj) { $skj++; }
	    }
	    $matrix[$j][$k] = $sjk;
	    $matrix[$k][$j] = $skj;
	}
    }

    $beatpath::n = $num_choices;
    for (my $j = 0; $j < $num_choices; $j++) {
	for (my $k = 0; $k < $num_choices; $k++) {
	    $beatpath::matrix[$j][$k] = $matrix[$j][$k];
	}
    }
    &beatpath::rank_candidates();
    @result = @beatpath::result;
    @choice_index = @beatpath::choice_index;
    @closure_matrix = ();
    for (my $j = 0; $j < $num_choices; $j++) {
	for (my $k = 0; $k < $num_choices; $k++) {
	    $closure_matrix[$j][$k] = $beatpath::closure_matrix[$j][$k];
	}
    }
    #@closure_matrix = @beatpath::closure_matrix;
    $j = 0;
    for (my $rank = 0; $rank <= $#result; $rank++) {
	my @winner = @{$result[$rank]};
	for (my $i = 0; $i <= $#winner; $i++) {
	    $choice_index[$j] = $winner[$i];
	    $choice_rank[$winner[$i]] = $j + 1;
	    $j++;
	}
    }
    #print_nonprop_results;
# Now we're ready to report the choices

    sub renumber {
# convert a committee into the rank-ordered form
	my @comm = split /,/, $_[0];
	my @mapped;
	for (my $j = 0; $j < $num_winners; $j++) {
	    $mapped[$j] = $choice_rank[$comm[$j]];
	}
	@mapped = sort {$a <=> $b} @mapped;
	return @mapped;
    }

    print "<h2>Choices (in individual preference order)</h2>";
    print "<ol>";
    for (my $j = 0; $j < $num_choices; $j++) {
	print "<li> ".$choices[$choice_index[$j]]."</li>\n";
    }
    print "</ol>";

    $prop_details = 0;

    if ($prop_details) {
	print '<h2>Log of search for best result set</h2>'.$cr;
    }
    STDOUT->flush();

    if ($prop_details) {
	print '<pre>';
    }
    if ($num_votes != $#voter_keys + 1) {
	print "Warning: discrepancy between number of
	recorded voters and number of recorded votes!";
    }
# A committee is represented either as an array of integers
# or as a string containing a comma-separated series of integers,
# where those integers are 0-based indices into the @choices array.
# In either case the indices are sorted in ascending order.

    sub kPrefVoter {
# kPrefVoter(f, v, c1, c2) is 1 if voter with index $v
#   has a f-preference for committee c1, 1 if a f-preference
#   for committee c2, and 0 otherwise. Choices are indexed in
#   0..$num_choices-1, voters in 0..$num_votes. c1 and c2 are
#   represented as strings.
	my ($f, $v, $i, $j) = @_;
	$voter_key = $voter_keys[$v];
	$ratings = $vdata_copy{$voter_key};
	@ratings = split /,/, $ratings;

	#print "Voter: $ratings considering $i vs. $j with $f-pref\n";

	@c1 = split /,/, $i;
	@c2 = split /,/, $j;

        $sum = 0;
	my $k;
	for (my $k = 0; $k < $num_winners; $k++) {
	    if ($real_prop eq 'yes') {
		@w1[$k] = $ratings[$c1[$k]];
		@w2[$k] = $ratings[$c2[$k]];
	    } else {
		@w1[$k] = $num_choices - $ratings[$c1[$k]];
		@w2[$k] = $num_choices - $ratings[$c2[$k]];
	    }

	}
	@w1 = sort {$a <=> $b} @w1;
	@w2 = sort {$a <=> $b} @w2;
	$sum1 = $sum2 = 0;
	for (my $k = 1; $k <= $f; $k++) {
	    $sum1 += $w1[$num_winners - $k];
	    $sum2 += $w2[$num_winners - $k];
	    if ($sum1 != $sum2 && !$use_combined_ratings) { last; }
	}
	#print "Results before trimming are @w1 and @w2\n";
	#print "Admissible rating totals are $sum1, $sum2\n";
	if ($sum1 > $sum2) { return -1; }
	elsif ($sum1 < $sum2) { return 1; }
	else { return 0; }
    }

    sub kPref {
# kPref(f, c1, c2) sets $ipref to the number of voters with
# a f-preference for committee c1, and $jpref to the number of
# voters with a k-preference for committee c2.  c1 and c2
# are represented as strings. If there is no valid k-preference
# both $ipref and $jpref are set to zero.
	my ($f, $i, $j) = @_;
	#print "Comparing $i to $j at $f-preference. ";
	my ($icnt, $jcnt) = (0,0);
	for (my $v = 0; $v < $num_votes; $v++) {
	    if ($f == 0) {
		$c = kPrefVoter($num_winners, $v, $i, $j);
	    } else {
		$c = kPrefVoter($f, $v, $i, $j);
	    }
	    if ($c == -1) { $icnt++; }
	    elsif ($c == 1) { $jcnt++; }
	}
	#print "Simple count yields $icnt, $jcnt\n";
# now throw out invalid f-preferences
	$ipref = $icnt; $jpref = $jcnt;
	if ($f != 0 && $ipref > 0 && ($ipref * ($num_winners+1)/$num_votes) < $f) {
	    #print "Pref 1 is invalid\n";
	    $ipref = 0;
	}
	if ($f != 0 && $jpref > 0 && ($jpref * ($num_winners+1)/$num_votes) < $f) {
	    #print "Pref 2 is invalid\n";
	    $jpref = 0;
	}
    }
    #print "num choices = $num_choices, num winners = $num_winners\n";

    if ($num_choices > $num_winners) {
# need to throw out some choices...
# XXX This all needs to be reimplemented more carefully

	sub flatten {
	    my $ret = $_[0];
	    for (my $i = 1; $i <= $#_; $i++) {
		$ret .= "," . $_[$i];
	    }
	    return $ret;
	}
	sub compute_in {
	    my @c = @{$_[0]};
	    my $i;
	    for (my $i = 0; $i < $num_choices; $i++) { $in{$i} = 0; }
	    for (my $i = 0; $i < $num_winners; $i++) { $in{$c[$i]} = 1; }
	}
	$change = 1;

# @committee is the array of all visited committees
# %cindex is the index of committees
# $borm[ci1][ci2] is whether comm with index ci2 beats or matches
#    (transitively) the one with ci2

	my @curr_comm, $curr_comm;
	for (my $i = 0; $i < $num_winners && $i < $num_choices; $i++) {
	    $curr_comm[$i] = $choice_index[$i];
	}
	@curr_comm = sort { $a <=> $b } @curr_comm;
	$curr_comm = flatten @curr_comm;

	$iters = 0;
	$full_search = 0;
	$depth = 0;
	$recurse = 1;
	sub dprint {
	    my $msg = $_[0];
	#   for (my $i = 0; $i < $depth; $i++) {
	#     print " ";
	#   }
	    if ($prop_details) {
		print $msg;
	    }
	}

	sub compare_sets {
# compare_sets compares two sets and returns
# 1 if the latter is better.
	    my $curr_comm = $_[0];
	    my $new_comm = $_[1];
	    # dprint flatten(renumber($curr_comm)).' vs. '.flatten(renumber($new_comm)).":$cr";
	    my $bestpref = 0;
	    my $bestpreffor = 0;
	    my $bestprefagainst = $num_choices;
	    my $bestipref = 0;
	    my $bestjpref = 0;
	    $seen{$curr_comm} = $seen{$new_comm} = 1;
	    for (my $f = 1; $f <= $num_winners; $f++) {
		kPref($f, $curr_comm, $new_comm);
		if ($ipref >= $bestpreffor && $jpref <= $bestprefagainst) {
		    $bestpreffor = $bestipref = $ipref;
		    $bestprefagainst = $bestjpref = $jpref;
		}
		if ($jpref >= $bestpreffor && $ipref <= $bestprefagainst) {
		    $bestpreffor = $bestjpref = $jpref;
		    $bestprefagainst = $bestipref = $ipref;
		}
	    }
	    # print "best f-preference tally: $bestipref to $bestjpref\n";
	    $tally1{$curr_comm}{$new_comm} = $bestipref;
	    $tally2{$curr_comm}{$new_comm} = $bestjpref;
	    kPref(0, $curr_comm, $new_comm);
	    #print "weak pref: $ipref to $jpref\n";
	    $weaktally1{$curr_comm}{$new_comm} = $ipref;
	    $weaktally2{$curr_comm}{$new_comm} = $jpref;

	    if ($bestjpref > $bestipref) {
		dprint flatten(renumber($new_comm)).' is preferred to '.
		       flatten(renumber($curr_comm)).
		", $bestjpref&ndash;$bestipref$cr";
		if ($recurse) {
		    my $save_full_search = $full_search;
		    visit($new_comm);
		    $full_search = $save_full_search;
		}
		return 1;
	    } elsif ($bestjpref == $bestipref) {
		if ($jpref > $ipref
		    # || ($full_search && $jpref == $ipref)
		    ) {
		    dprint "$new_comm is (weakly) preferred to $curr_comm, $jpref&ndash;$ipref\n";
		    # if ($jpref == $ipref) {
		    # dprint "  ...exploring because a cycle has been detected\n";
		    # }
		    if ($recurse) {
			my $save_full_search = $full_search;
			visit($new_comm);
			$full_search = $save_full_search;
		    }
		    return 1;
		}
	    }
	    return 0;
	}
	sub visit {
# XXX this function is a mess.
# visit(c): visit all the committees that beat
#   or match c, where b is a set of committees
#   known to be beaten by c.
# effects: sets $tally1{c1}{c2} to the strong preference for c1 over c2
#          sets $tally2{c1}{c2} to the strong preference for c2 over c1
#          sets $weaktally1{c1}{c2}, $weaktally2{c1}{c2} correspondingly
# requires: $beaten[0..$num_beaten-1] is a set of 
#   committees known to be beaten (or matched) transitively by c
	    $iters++;
	    if ($iters > 500) { return; } # truncate runaway search
	    $depth++;

	    my $comm = $_[0];
	    my @comm = split /,/, $comm;
	    my $cci;
	    my $added = 0;
	    if ($visited{$comm}) {
		dprint "already visited: $comm\n";
		if ($full_search) { $depth--; return; }
		if (!$full_search) {
		    if ($prop_details) {
		    dprint "$comm is in a cycle (in the Schwartz set?)\n";
		    }
		    $full_search = 1;
		}
	    } else {
		$cci = $#committee + 1;
		$committee[$cci] = $comm;
		$cindex{$comm} = $cci;
		$mcomm = flatten(renumber($comm));
		if ($prop_details) {
		    dprint "<b>Considering set: $mcomm ($comm)</b>\n";
		}
		$visited{$comm} = 1;
		dprint "setting visited: $comm\n";
		$added = 1;
	    }
	    $cci = $cindex{$comm};
	    my $change = 0;
	    my $save_beaten = $beaten[$cci];
	    $beaten[$cci] = 1;
	    for (my $b = 0; $b <= $#committee; $b++) {
# check if any new beaten info has shown up and add to @borm
# if so.
		if ($beaten[$b] && !$borm[$cci][$b]) {
		    $change = 1;
		    $borm[$cci][$b] = 1;
		    # print "$committee[$cci] beats $committee[$b]\n";
		}
	    }
	    if ($change) {
		if (!$added) {
		    # dprint "Change to beaten info, revisiting from $comm\n";
		}
		my @new_comm, $new_comm;
		compute_in [@comm];
		my $done = 0;
		for (my $i = 0; $i < $num_winners && !$done; $i++) {
# try improving each current member
		    for (my $j = 0; $j < $num_choices && !$done; $j++) {
			@new_comm = @comm;
# try replacing with each choice not currently in the committee
			if (!$in{$j}) {
			    my %save_in = %in;
			    $new_comm[$i] = $j;
			    @new_comm = sort {$a <=> $b} @new_comm ;
			    $new_comm = flatten @new_comm;
			    # dprint "Constructed $new_comm\n";
			    if (
				!$visited{$new_comm} &&
				compare_sets($comm, $new_comm)) {
				# if (!$full_search)
				{ $done = 1; }
# XXX obsolete
# If this committee isn't in the Schwartz set then there is
# no reason to compare to any more committees, because we
# already found at least one that is better than this one.
			    }
			    %in = %save_in;
			} else {
			    # print "Can't add $j, it's already in $comm\n";
			}
		    } # for j
		} # for i
		if (!$done && $added) {
		    $mcomm = flatten(renumber($comm));
		    if ($prop_details) {
			dprint "$mcomm beats all nearby unvisited sets\n";
		    }
		}
	    } # if change
	    $beaten[$cci] = $save_beaten;
	    # dprint "<b>Done with ".flatten(renumber($comm))."</b>\n";
	    $depth--;
	}
	visit($curr_comm);

	# $num_unbeaten = $#committee + 1;
	# for (my $i = 0; $i <= $#committee; $i++) {
	    # $unbeaten[$i] = 1;
	# }
	# for (my $i = 0; $i <= $#committee; $i++) {
	    # for (my $j = 0; $j <= $#committee; $j++) {
		# if ($unbeaten[$i] && !$borm[$i][$j]) {
		    # $unbeaten[$i] = 0;
		    # $num_unbeaten--;
		# }
	    # }
	# }
    } # if need to pick winners
    if ($prop_details) { print "</pre>"; }

    if ($iters > 500) {
	print p(b('Search for best set of choices failed.
	Results are likely to be incorrect.'));
    }
# add some obvious contenders: all but one of the top num_choices+1
    if ($prop_details) {
	print '<pre>'.b('Adding obvious contenders:').$cr;
    }
    for (my $j = 0; $j <= $num_winners; $j++) {
	@a = ();
	for (my $k = 0; $k <= $num_winners; $k++) {
	    if ($j != $k) { push @a, $choice_index[$k]; }
	}
	@a = sort {$a <=> $b} @a;
	my $comm = flatten @a;
	if (!$visited{$comm}) {
	    push @committee, $comm;
	    if ($prop_details) {
		print 'added '.flatten(renumber($comm))." ($comm)".$cr;
	    }
	    $num_visited++;
	}
    }
    dprint '</pre>'.b('Acquiring any missing preference information...<pre>').$cr;
    STDOUT->flush();

    $recurse = 0;
    $divisor = 1;
    while ($divisor < $num_votes) { $divisor *= 10; }


    for (my $j = 0; $j <= $#committee; $j++) {
	for (my $k = 0; $k < $j; $k++) {
	    my $curr_comm = $committee[$j];
	    my $new_comm = $committee[$k];
	    compare_sets($curr_comm, $new_comm);
	    my $jk = $tally1{$curr_comm}{$new_comm};
	    my $kj = $tally2{$curr_comm}{$new_comm};
	    $beatpath::matrix[$j][$k] = $cmatrix[$j][$k] = $jk;
	    $beatpath::matrix[$k][$j] = $cmatrix[$k][$j] = $kj;

		$beatpath::matrix[$j][$k] = $cmatrix[$j][$k] +=
		    $weaktally1{$curr_comm}{$new_comm}/$divisor;
		$beatpath::matrix[$k][$j] = $cmatrix[$k][$j] +=
		    $weaktally2{$curr_comm}{$new_comm}/$divisor;
	}
    }
    if ($prop_details) {
	print '</pre>';
    }
    $beatpath::n = $#committee + 1;
    &beatpath::rank_candidates();
    @cresult = @beatpath::result;
    @committee_cmatrix = @beatpath::closure_matrix;
    @comm_choice_index = @beatpath::choice_index;
    $j = 0;
    my @cwinner = @{$cresult[0]};
    $num_unbeaten = $#cwinner + 1;
    if ($num_unbeaten == 1) {
	print h2("Winning set of choices".$cr);
	print p("The <a href=\"@CIVSURL@/proportional.html\">apparent</a> winner of this election was the following set of choices:");
    } else {
	print h2("Winning sets of choices$cr");
	print p("There were $num_unbeaten unbeaten sets:$cr");
    }
    print '<table class="rankings"><tr>';
    for (my $i = 0; $i < $num_unbeaten; $i++) {
	print '<td><ol>';
	@mapped_comm = renumber($committee[$cwinner[$i]]);
	for (my $j = 0; $j < $num_winners; $j++) {
	    $j1 = $mapped_comm[$j];
	    $j2 = $choice_index[$j1 - 1];
	    print "<li value=\"$j1\"> <b>$choices[$j2]</b>".$cr;
	}
	print '</ol></td>';
    }
    print '</tr></table>';
    print h2('Preference matrix');
    my $combinations = 1;
    my $num_seen = 0;
    for (my $i = 0; $i < $num_winners; $i++) {
	$combinations *= ($num_choices - $i);
    }
    for (my $i = 0; $i < $num_winners; $i++) {
	$combinations /= ($i + 1);
    }
    foreach my $k (keys %seen) {
	$num_seen++;
    }
    $num_visited = $#committee + 1;

    print p("There are $combinations possible sets of $num_winners choices
    that can be formed by selecting from the $num_choices choices. Of these,
      $num_visited sets were considered thoroughly, comparing against 
      the $num_seen nearby (similar) sets that differ
      in just one choice.$cr");


    print p('This is the voting preference matrix,
             reporting maximal valid proportional preferences.
	     Fractions indicate nonproportional preferences, which
	     help break ties in proportional preference.');
    STDOUT->flush();
    
    for (my $j = 0; $j <= $#committee; $j++) {
	$comm_choices[$j] = '('.flatten(renumber($committee[$j])).')';
    }
    PrintMatrix $#committee+1, [@cmatrix], [@comm_choices], [@comm_choice_index], 0;

    if ($detailed) {
	print h2('<a name="committee_beatpath">Beatpath closure matrix</a>');
	print p('The following is the corresponding
		beatpath matrix. Sets of choices 1 is preferred
		to sets of choices 2 if there is a better beatpath leading from 1 to 2
		than any leading from 2 to 1.');
	STDOUT->flush();

	PrintMatrix $#committee+1, [@committee_cmatrix], [@comm_choices], [@comm_choice_index], 1;

    } else {
	    $details_url = "$thisurl?id=$election_id&num_winners=$num_winners" . '&detailed=1#committee_beatpath';
	    $link = a({-href=>"$details_url"},
		'Detailed results are also available.');
	    print p($bookmark.$link);
    }
    print hr();
    print '<a name="comparison"></a>';
    print h2("Pairwise comparison");

    print p("You can compare any two sets of choices.
    Just enter the numbers of the choices (from 1 to $num_choices) in each set, with the
    numbers of one set's choices in the left column and the numbers of the other's
    in the right column.");
    print '<form method="POST"
	    action="'.$thisurl.'#comparison"
	    enctype="multipart/form-data"
	    name="CompareSets">';

    print '<table class="comparison">';
    $comparison_request = param('Compare');
    if (defined($comparison_request) && $comparison_request ne '') {
	$comparison_request = 1;
    } else {
	$comparison_request = 0;
    }
    @curr_comm = split /,/, $committee[$cwinner[0]];
    print '<tr><th width=40px>Set 1</th><th width=40px>Set 2</th></tr>';
    for (my $i = 1; $i <= $num_winners; $i++) {
	my $besti = $curr_comm[$i-1];
	my $li, $ri;
	if ($comparison_request) {
	    $li = param("L$i");
	    $ri = param("R$i");
	} else {
	    $li = $choice_rank[$curr_comm[$i-1]];
	    $ri = "?";
	}
	print "<tr><td><input type=\"text\" name=\"L$i\" size=\"3\" value=\"$li\"></td>\n";
	print "<td><input type=\"text\" name=\"R$i\" size=\"3\" value=\"$ri\"></tr>";
    }
    print '</table>';
    print hidden('id', $election_id);
    print hidden('num_winners', $num_winners);
    print hidden('algorithm', $num_winners);
    print '<input type="submit" value="Compare sets" name="Compare">';
    print '</form>';
    if ($comparison_request) {
	for (my $i = 1; $i <= $num_winners; $i++) {
	    $curr_comm[$i-1] = $choice_index[param("L$i") - 1];
	    $new_comm[$i-1] = $choice_index[param("R$i") - 1];
	}
	@curr_comm = sort {$a <=> $b} @curr_comm;
	@new_comm = sort {$a <=> $b} @new_comm;
	$curr_comm = flatten @curr_comm;
	$new_comm = flatten @new_comm;
	$ccname = flatten(renumber($curr_comm));
	$ncname = flatten(renumber($new_comm));

	print h3("$ccname vs. $ncname");
	$recurse = 0;
	print '<pre>';
	compare_sets($curr_comm, $new_comm);
	print '</pre>';

	$t1 = $tally1{$curr_comm}{$new_comm};
	$t2 = $tally2{$curr_comm}{$new_comm};
	if ($t1 eq '') {
	    print p('Could not compute preference for some reason.');
	}
	print '<p>Strong (proportional) preference: ';
	if ($t1 > $t2) {
	    print $ccname." is preferred by $t1 to $t2";
	} elsif ($t1 < $t2) {
	    print $ncname." is preferred by $t2 to $t1";
	} else {
	    print "tie, $t1 to $t2\n";
	}
	print '<br>';
	$t1 = $weaktally1{$curr_comm}{$new_comm};
	$t2 = $weaktally2{$curr_comm}{$new_comm};
	print 'Weak (nonproportional) preference: ';
	if ($t1 > $t2) {
	    print $ccname." is preferred by $t1 to $t2\n";
	} elsif ($t1 < $t2) {
	    print $ncname." is preferred by $t2 to $t1\n";
	} else {
	    print "tie, $t1 to $t2\n";
	}
	print '</p>';
	print p(b("Note:").' Nonproportional preferences are relevant only if there is a tie in proportional preferences.');
    }
    print "<hr>\n";
    STDOUT->flush();
    print h2('Nonproportional election');
    print p('The following gives the details of how the election
             would have resulted if run on single choices, without
	     proportional representation. This hypothetical
	     election defines the &ldquo;individual preference
	     order&rdquo; used above.');

    print h2('Ranking of the choices').$cr;
    print p('Winning choices are shown in bold.');

    if ($algorithm eq 'beatpath_winner') {
	&PrintBW;
    } else {
	&PrintRP;
    }
}

# The code that follows is by Alexandre Oliva.  It reads votes from
# standard input or from named input files.
sub ReadVotes {
  $choices[0] = '';
  $num_choices = 1;
    
  while (<>) {
    my @prefs = split /[>\n]/, $_;
    my @curprefs = ();
    my @voteranks = ();
    my @voted = ();
    for (my $i = 0; $i <= $#prefs; ++$i) {
      # print "$prefs[$i]\n";
      my @eqprefs = split(/=/, $prefs[$i]);
      my @nextprefs = @curprefs;
      for (my $j = 0; $j <= $#eqprefs; ++$j) {
	my $vote = $eqprefs[$j];
	# print "$vote\n";
	# Map -1 to 0, to simplify matrix indexing.
	if ($vote == -1 || $vote == 0) {
	  if ($choices[0] eq '') {
	    $choices[0] = $vote
	  } elsif ($choices[0] != $vote) {
	    die 'there must not be votes for both 0 and -1';
	  }
	  $vote = 0;
	} elsif ($vote < 0) {
	  die 'there must not be negative votes';
	}
	die 'an option must be present at most once per vote'
	  if ($voted[$vote]);
	$voted[$vote] = 1;
	while ($vote >= $num_choices) {
	  $choices[$num_choices] = $num_choices;
	  ++$num_choices;
	}
	$voteranks[$vote] = $i + 1;
	push @nextprefs, $vote;
	for (my $k = 0; $k <= $#curprefs; ++$k) {
	  ++$vdata{"$curprefs[$k].$vote"};
	  # print "$curprefs[$k] defeats $vote " . $vdata{"$curprefs[$k].$vote"} . " times so far.\n";
	}
      }
      @curprefs = @nextprefs;
    }
    $voter_keys[$num_votes] = $num_votes;
    my $rating = '' . $voteranks[$0];
    for ($i = 1; $i < $num_choices; ++$i) {
      $rating .= ',' . $voteranks[$i];
    }
    $vdata{'recorded_voters'} .= "$num_votes\n";
    $vdata{$num_votes} = $rating;
    ++$num_votes;
  }

  # for debugging:
  # exit 0;
}

# stub, we don't want to randomize vote order
sub fisher_yates_shuffle (@voters) {
}
