Skip to content

Instantly share code, notes, and snippets.

@RogerDodger
Created August 25, 2012 07:59
Show Gist options
  • Save RogerDodger/3462311 to your computer and use it in GitHub Desktop.
Save RogerDodger/3462311 to your computer and use it in GitHub Desktop.
Distributes stories to judges (using input from UNIX wc)
#!/usr/bin/perl -w
use warnings;
use strict;
use List::Util qw/shuffle min sum/;
use feature qw/say/;
use utf8;
# Usage:
# $wc *.txt | $0 <outfile>
my $outfile = shift or die "No args given";
if(-e $outfile) {
die "$outfile is not writable" unless -w $outfile;
}
open WRITE, ">", $outfile;
#How many stories each participant will read
use constant SIZE => 6;
# Parse input from the Unix wc function.
#
# Story info is stored in a hash where
# keys are the story names, and
# values are their word counts
my %w;
while (<STDIN>) {
if (/\s+\d+\s+(\d+)\s+\d+\s+(.+)\.txt/) {
my($words, $story) = ($1, $2);
$w{$story} = $words;
}
}
die "Need more stories" if keys %w <= SIZE;
# Define system state hash, %s.
#
# keys are the story names, and
# values are SIZE random story names that are not equal to each other and are
# not the same as the key (a judge should not be assigned his/her own story,
# nor should a judge have the same story twice).
#
# Each story is in the system SIZE times.
my @keys = keys %w;
my %s;
$s{$_} = [] for @keys;
for(1..SIZE) {
my @e = @keys;
while(collisions_exist(\@e, \@keys, \%s)) {
@e = shuffle(@e);
}
my $n = @e;
for(my $i = 0; $i < $n; $i++) {
my $pool = $s{$keys[$i]};
push @$pool, $e[$i];
}
}
#Main algorithm
for(my $i = 0; $i <= 1000; $i++) {
#Define two random cells to be swapped
my $cell1 = {
x => int rand(SIZE),
y => int rand(@keys),
};
my $cell2 = {
x => int rand(SIZE),
y => int rand(@keys),
};
#No point swapping cells between the same judge
redo if $cell1->{y} == $cell2->{y};
my $judge1 = $keys[$cell1->{y}];
my $judge2 = $keys[$cell2->{y}];
my $pool1 = $s{$judge1};
my $pool2 = $s{$judge2};
my $story1 = $pool1->[$cell1->{x}];
my $story2 = $pool2->[$cell2->{x}];
#Don't put a story in a pool if it's already there
redo if grep {$story1 eq $_} @$pool2;
redo if grep {$story2 eq $_} @$pool1;
#Don't put a judge's own story in his/her pool
redo if $judge1 eq $story2;
redo if $judge2 eq $story1;
my $work_init = work(\%s, \%w);
cell_swap($cell1, $cell2, \%s, \@keys);
my $work_new = work(\%s, \%w);
if($work_new < $work_init) {
$i = 0;
say "New: $work_new";
} else {
cell_swap($cell1, $cell2, \%s, \@keys);
}
}
say WRITE "$_\t".(sum map {$w{$_}} @{$s{$_}})."\t".join "\t", @{$s{$_}} for @keys;
#__SUBROUTINE DEFINITIONS__
# Given two cells in the system, the system hash, and the system's keys,
# swap the two cells
sub cell_swap {
my($cell1, $cell2, $s, $keys) = @_;
#It's really not all that confusing when you think about it!
my $tmp = $s->{$keys->[$cell1->{y}]}->[$cell1->{x}];
$s->{$keys->[$cell1->{y}]}->[$cell1->{x}] =
$s->{$keys->[$cell2->{y}]}->[$cell2->{x}];
$s->{$keys->[$cell2->{y}]}->[$cell2->{x}] = $tmp;
}
# Sub to check if there are any collisions, i.e., violations
# of the initial state's criteria: values != other values nor keys
sub collisions_exist {
my($e, $keys, $s) = @_;
my $n = @$e;
for(my $i = 0; $i < $n; $i++) {
return 1 if $e->[$i] eq $keys->[$i];
my $pool = $s->{$keys->[$i]};
return 1 if grep {$e->[$i] eq $_} @$pool;
}
0;
}
#Calculate the total work required of the judges in the current system
sub work {
my($system, $w) = @_;
my $work;
for my $key (keys %$system) {
my $sum;
for my $i (0..SIZE-1) {
$sum += $w->{$system->{$key}->[$i]};
}
$work += $sum*($sum+1)/2;
}
return $work;
}
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment