Runs through stories in heats to judge which ones are best.

storyVoter.pl

#!/usr/bin/perl

use warnings;
use strict;
use List::Util qw/shuffle/;

if($#ARGV != 2 || grep {$ARGV[0] eq $_} qw/help h/) {
	print
"Usage: perl $0 <inputfile> <outputfile> <groupsize>\n",
"  <inputfile> is the name of the file containing the stories to be\n",
"voted on. The stories must be separated by newlines.\n",
"  <outputfile> is the name of the file that the data will be written to.\n",
"  <groupsize> is the maximum number of stories a group can have.\n",
"\n",
"  e.g., perl $0 stories.txt data.txt 5\n",
"\n",
"  Output is formatted with tabs as the column delimiter, so you can\n",
"copy/paste the output straight into the spreadsheet without a hassle.\n",
"\n",
"  The program will continue running heats until either 25 rounds have been run\n",
"or it receives the input \"end\", at which point it will write the data to\n",
"<outputfile> at the end of the round and terminate.\n",
"  At the start of each heat, the stories to be ranked will be listed alongside\n",
"numeric indexes. You must order the indexes from best story to worst story,\n",
"separated by whitespace, e.g.,\n",
"\n",
"  HEAT 1\n",
"[0] - Fabulous Placeholders\n",
"[1] - We Want More Placeholders\n",
"[2] - Why Can't I Hold All These Placeholders?\n",
"[3] - This Isn't Really a Placeholder\n",
"Ranking: 0 2 3 1\n",
"\n",
"  The previous example ranks \"Fabulous Placeholders\" as the best story\n",
"and \"We Want More Placeholders\" as the worst.\n";
	exit;
}

my($infile, $outfile, $groupsize) = @ARGV;
open READ, $infile or die "Cannot open file $infile: $!";
die "\<groupsize> must be a positive integer greater than 1" if 
    abs int $groupsize != $groupsize ||
    $groupsize <= 1;

if(-e $outfile) {
	exit "$outfile is not writable" unless -w $outfile;
	my $in = prompt(
"\"$outfile\" exists. Proceeding will overwrite it.\n".
"Do you want to continue [y/n]? ");
	exit unless $in =~ /^(y|yes)$/i;
}
open WRITE, ">", $outfile or die "Cannot open file $outfile: $!";

# Read contents of $file and store into the hash %tally, with each line being
# a new key in the hash
# 
# The default value of every key is an empty arrayref so that the scores can be
# stored in them later
my %tally;
while($_ = <READ>) {
	s/^\s+|\s+$//g;
	$tally{$_} = [] unless $_ eq '';
}


my @stories = keys %tally;
my $entrants = scalar @stories;
my $groupcount = ceil($entrants / $groupsize); #the number of groups to make
my $ratio = $entrants/$groupcount; #the average number of stories in each group

my $end = 0;
for(my $round = 1; $round <= 25 && !$end; $round++) {
	#shuffle the story names
	@stories = shuffle(@stories) for 0 x 10;
	
	printf "\nROUND %02d\n========\n", $round;
	
	my $heatNo = 1;
	#Run heats for this round
	for(my $i = 0; $i <= $#stories; $i += $ratio) {
		
		# Get m stories for this heat
		#
		# @heatStories contains the names of the stories in the current heat,
		# which correspond to keys in the %tally hash
		#
		# Prompt for rankings
		print "\n  HEAT $heatNo\n";
		my @heatStories = @stories[$i..$i+$ratio-.999]; 
		#.999 instead of 1 to deal with rounding errors

		my $m = scalar @heatStories;
		for(my $index = 0; $index < $m; $index++) {
				printf "%-4s- %s\n", "[$index]", $heatStories[$index];
		} 
	
		while(my $in = prompt("Ranking: ") || 1) {
			my @in = split(/\s+/, $in);
			# check if input contains all values from 0 to m-1
			if(isValidRanking(\@in, $m-1)) {
				for(my $p = 1; $p <= $m; $p++) {
					# score the pth ranked story by the formula 1+m-2p
					#
					# m is the number of stories in the group
					push @{$tally{$heatStories[$in[$p-1]]}}, 1+$m-2*$p;
				}
				last;
			} elsif(!$end && grep {$in[0] eq $_} qw/end exit write/) {
				print "End signal received. Will write to \"$outfile\" at end of round.\n";
				$end = 1;
			} else {
				print "Try again.\n";
			}
		}		
		$heatNo++;
	}
	print "\n";
}

print "Writing to \"$outfile\". . .\n";
for(sort {$a cmp $b} keys %tally) {
	print WRITE join("\t", $_, @{$tally{$_}}), "\n";
}
print "Done.\n";

sub ceil {
	my $n = shift;
	return $n if $n == int $n;
	return int $n + 1;
}

sub prompt {
	print shift; 
	(my $input = <STDIN>) =~ s/^\s+|\s+$//g;
	return $input;
}

sub isValidRanking {
	my @entries = @{(shift)};
	#ensure only digits are given before trying numeric sort
	return if grep /\D/, @entries;
	@entries = sort {$a <=> $b} @entries;
	
	my @valid = 0..shift;
	return 1 if @entries ~~ @valid;
	0;
}