#!/usr/bin/perl -w

use strict;

# Give detailed processing information and calculate the winner according
# to Cloneproof SSD.

####
# Parse input
#
# On <>, expect the processed votes, of the form:
#    V: -324-1
# interpreted as rating the 6th option as your 1st preference, etc
# Assumes options 2, 3, 4 and 6 are all preferred over options 1 and
# 5, but no preference is given between options 1 and 5

my %beats;   # Votes preferring A to B == $beats{"$a $b"}
my $candidates = 0;

while(my $line = <>) {
  chomp $line;
  next unless ($line =~ m/^V: (\S+)\s*$/);
  my $vote = $1;
  $candidates = length($vote) unless ($candidates >= length($vote));
  for my $l (1..($candidates-1)) {
    for my $r (($l+1)..$candidates) {
      unless (defined $beats{"$l $r"}) {
	$beats{"$l $r"} = 0;
	$beats{"$r $l"} = 0;
      }

      my $L = substr($vote, $l-1, 1);
      my $R = substr($vote, $r-1, 1);

      if ($L eq "-" && $R eq "-") {
	next;
      } elsif ($R eq "-" || ($L ne "-" && $L < $R)) {
	$beats{"$l $r"}++;
      } elsif ($L eq "-" || $R < $L) {
	$beats{"$r $l"}++;
      } else {
	# equally ranked, tsk tsk
      }
    }
  }
}

####
# Determine defeats, based on how many votes ranked some candidate above
# another candidate.

my %defeat = ();

print "Calculating defeats\n";
for my $l (1..$candidates) {
  for my $r (1..$candidates) {
    next if ($l == $r);

    my $LR = $beats{"$l $r"};
    my $RL = $beats{"$r $l"};
    if ($LR > $RL) {
      $defeat{"$l $r"} = "$LR $RL";
    } elsif ($l < $r && $LR == $RL) {
      print "Exact tie between $l and $r : $LR $RL\n";
    }
  }
}
print "\n";

####
# Determine the winner according to Cloneproof SSD.
#
#     1. Calculate Schwartz set according to uneliminated defeats.
#     2. If there are no defeats amongst the Schwartz set:
#	    2a. If there is only one member in the Schwartz set, it wins.
#           2b. Otherwise, there is a tie amongst the Schwatz set.
#           2c. End
#     3. If there are defeats amongst the Schwartz set:
#           3a. Eliminate the weakest defeat/s.
#           3b. Repeat, beginning at 1.

my $phase = 0;
while(1) {
  $phase++;
  print "Defeats at beginning of phase $phase:\n";
  for my $d (sort keys %defeat) {
    my ($l, $r) = split /\s+/, $d;
    print "    $l beats $r: $defeat{$d}\n";
  }

  my @schwartz = calculate_schwartz();
  print "Schwartz set: " . join(",", @schwartz) . "\n";

  my @schwartzdefeats =
    grep { defined $defeat{$_} } crossproduct(@schwartz);

  if (!@schwartzdefeats) {
    print "No defeats left in Schwartz set!\n";
    if (@schwartz == 1) {
      print "Winner is: $schwartz[0]\n";
    } else {
      print "Tie amongst: " . join(", ", @schwartz) . "\n";
    }
    last;
  }

  my $weakest = (sort { defeatcmp($defeat{$a},$defeat{$b}) }
		 @schwartzdefeats)[0];

  my $weakstrength = $defeat{$weakest};
  print "Weakest defeat amongst schwartz set is $weakstrength\n";

  for my $d (@schwartzdefeats) {
    die "Defeat weaker than weakest! $d, $weakstrength, $defeat{$d}"
      if (defeatcmp($defeat{$d}, $weakstrength) < 0);
    if (defeatcmp($defeat{$d}, $weakstrength) == 0) {
      print "Removing defeat $d, $defeat{$d}\n";
      delete $defeat{$d};
    }
  }
  print "\n";
}

sub crossproduct {
  my @l = @_;
  return map { my $k = $_; map { "$k $_" } @l } @l;
}

sub defeatcmp {
  my ($Awin, $Alose) = split /\s+/, shift;
  my ($Bwin, $Blose) = split /\s+/, shift;

  return 1 if ($Awin > $Bwin);
  return -1 if ($Awin < $Bwin);
  return 1 if ($Alose < $Blose);
  return -1 if ($Alose > $Blose);

  return 0;
}

####
# Code to calculate the schwartz set
#
# We note that given two unbeaten subsets, S and T, either, then S^T is
# also unbeaten, so either S^T is empty, or S^T is a smaller unbeaten subset.
#
# We can thus find a unique, smallest unbeaten set containing each candidate
# by a simple iterative method. This is find_unbeaten_superset.
#
# So given the smallest supersets for each candidate, we have all the smallest
# unbeaten subsets (since each one will be the smallest superset of any of
# its members). So, each set is either a proper superset of another set
# (and can thus be discarded), or it's a smallest unbeaten subset.
#
# We eliminate the sets in and then union the remainder (which are either
# equal or disjoint), and we've thus found the Schwartz set. This is
# done in calculate_schwartz.

sub find_unbeaten_superset {
  my @l = @_;
  for my $r (1..$candidates) {
    my $add = 1;
    for my $l (@l) {
      if ($l == $r) {
	$add = 0;
	next;
      }
    }
    next unless ($add);
    $add = 0;
    for my $l (@l) {
      if (defined $defeat{"$r $l"}) {
	$add = 1;
      }
    }
    if ($add) {
      return find_unbeaten_superset(@l, $r);
    }
  }
  return sort(@l);
}


sub is_subset {
  my @l = @{$_[0]};
  my @r = @{$_[1]};

  for my $x (@r) {
    last if (!@l);
    shift @l if ($l[0] == $x);
  }

  return !@l;
}


sub calculate_schwartz {
  my @schwartz = ();
  for my $k (1..$candidates) {
    my @us = find_unbeaten_superset($k);
    my $new = 1;
    for my $x (@schwartz) {
      if (is_subset($x, \@us)) {
	$new = 0;
      } elsif (is_subset(\@us, $x)) {
	$x = \@us;
	$new = 0;
      }
    }
    if ($new) {
      push @schwartz, \@us;
    }
    #print "$k : " . join(",", @us) . "\n";
    #print "schwartz : " . join(":", map { join(",", @{$_}) } @schwartz) . "\n";
  }
  my @result = ();
  for my $x (@schwartz) {
    if (!is_subset($x, \@result)) {
      @result = sort(@result, @{$x});
    }
  }
  return @result;
}