#!/usr/bin/perl

use strict;

my $correct = undef;
my @canname = ();
my @canvote = ();
my $numdel = undef;
my $numcan = undef;
my %tiehash = ();

do {
  do {
    print "Enter number of delegates: ";
    chomp($numdel = <>);
  } until $numdel > 0 && $numdel =~ /^[0-9]+$/s;
  do {
    print "Enter number of candidates ";
    chomp($numcan = <>);
  } until $numcan > 0 && $numdel =~ /^[0-9]+$/s;

  @canname = ();
  @canvote = ();
  for my $can (1 .. $numcan) {
    do {
      print "Enter name of candidate $can: ";
      chomp($canname[$can] = <>);
    } until (grep { $_ eq $canname[$can] } @canname) == 1;
    do {
      print "Enter number of first-choice votes for $canname[$can]: ";
      chomp($canvote[$can] = <>);
      if (
           ((grep { $_ == $canvote[$can] } @canvote ) > 1) && 
           ($canvote[$can] > 0) || $tiehash{$can} ne undef
      ) {
        my @ties = grep {
          $canvote[$_] == $canvote[$can] and $_ != $can
        } 1 .. $#canname;
        for my $tie (@ties) {
          print "Tie between 1: $canname[$can] and 2: $canname[$tie]\n";
          my $tiebreak = 0;
          do {
            print "Select the tie winner (most second place votes), 1 or 2: ";
            chomp($tiehash{$can}{$tie} = <>);
          } until $tiehash{$can}{$tie} == 1 or $tiehash{$can}{$tie} == 2;
        }
      }
    } until $canvote[$can] =~ /^[0-9]+$/;
  }

  print "$numdel delegates being bound to $#canname candidates:\n";

  for my $can (1 .. $#canname) {
    print "$canname[$can] ($canvote[$can]) votes\n";
  }

  print "Is this correct (y/n) "; chomp($correct = <>);
} until $correct eq "y";

print "\nEliminating candidates who received no first-choice votes:\n";

for (my $can = 1; $can <= $#canname; $can++) {
  if($canvote[$can] == 0) {
    my @name = splice(@canname, $can, 1);
    my @vote = splice(@canvote, $can, 1);
    print "Candidate $name[0] removed with 0 first-choice votes\n";
    $can--;
  }
}

if ($#canname > $numdel) {
  my @sortvote = reverse(sort(@canvote[1 .. $#canname]));
  my $retain = $sortvote[$numdel-1];
  my $cutoff = $sortvote[$numdel];

  print "\nToo many candidates for the number of delegates.\n" .
        "Removing all the least first-choiced candidates to be " .
        "barely less than or equal to the number of delegates:\n";

  print "$cutoff or fewer votes will eliminated. " .
        "$retain or more votes will be retained.\n";

  for (my $can = 1; $can <= $#canname; $can++) {
    if($canvote[$can] <= $cutoff) {
      my @name = splice(@canname, $can, 1);
      my @vote = splice(@canvote, $can, 1);
      print "Candidate $name[0] removed with $vote[0] first-choice votes\n";
      $can--;
    }
  }
}

print "\nThe delegates are bound as follows:\n";

my @muls = ();
my @dels = ();
my @pris = ();

for my $del (2 .. $numdel) {
  $muls[$del] = 1 / sqrt($del * ($del - 1));
}

for my $can (1 .. $#canname) {
  $dels[$can]++;
  print "Delegate $can is delegate $dels[$can] for $canname[$can] " .
        "with infinite priority.\n";
  $pris[$can] = $muls[$dels[$can] + 1] * $canvote[$can];
}

for my $del (($#canname + 1) .. $numdel) {
  my $pri = 0;
  my $top = undef;

  my $mesg = "";
  for my $can (1 .. $#canname) {
    if ($pris[$can] == $pri) {
      if ($tiehash{$can}{$top} == 1) {
        $mesg .= "Candidate $canname[$can] beat $canname[$top] in a tie.\n";
        $top = $can; $pri = $pris[$can];
      } else {
        $mesg .= "Candidate $canname[$top] beat $canname[$can] in a tie.\n";
      }
    }
    if ($pris[$can] > $pri) { $top = $can; $pri = $pris[$can]; $mesg = ""; }
  }
  print $mesg;

  $dels[$top]++;
  print "Delegate $del is delegate $dels[$top] for $canname[$top] " .
        "with $pri priority.\n";
  $pris[$top] = $muls[$dels[$top] + 1] * $canvote[$top];
}

print "\nIn summary:\n";

for my $can (1 .. $#canname) {
  print "$dels[$can] delegate(s) for $canname[$can]\n";
}