Topological Sort

Score: 197.42 (pass)

More fun with perldoc perlrun

#!perl -lna
($l,$r)=@F;exists$p{$_}?next:x;$v{$l}+=0;if($l ne$r){++$v{$r};push@{$s{$l}},$r}}@t=grep{!$v{$_}}keys%v;while(@t){print$z=pop@t;map{push@t,$_ unless--$v{$_}}@{$s{$z}}}if(grep{$v{$_}}keys%v){die

Score: 199.41 (pass)

for becomes map, and I get under 200 strokes...

#!perl -ln
($l,$r)=split;exists$p{$_}?next:x;$v{$l}+=0;if($l ne$r){++$v{$r};push@{$s{$l}},$r}}@t=grep{!$v{$_}}keys%v;while(@t){print$z=pop@t;map{push@t,$_ unless--$v{$_}}@{$s{$z}}}if(grep{$v{$_}}keys%v){die

Score: 201.41 (pass)

And for that matter, although you can't just concat $l and $r to index into $p, you could use $_...

#!perl -ln
($l,$r)=split;exists$p{$_}?next:x;$v{$l}+=0;if($l ne$r){++$v{$r};push@{$s{$l}},$r}}@t=grep{!$v{$_}}keys%v;while(@t){print$z=pop@t;for(@{$s{$z}}){push@t,$_ unless--$v{$_}}}if(grep{$v{$_}}keys%v){die

Score: 205.41 (pass)

exists should create $p{$l}{$r}, so you don't need to ++ it...

#!perl -ln
($l,$r)=split;exists$p{$l}{$r}?next:x;$v{$l}+=0;if($l ne$r){++$v{$r};push@{$s{$l}},$r}}@t=grep{!$v{$_}}keys%v;while(@t){print$z=pop@t;for(@{$s{$z}}){push@t,$_ unless--$v{$_}}}if(grep{$v{$_}}keys%v){die

Score: 216.42 (pass)

A couple more strokes, since things aren't working at work... :(

#!perl -ln
($l,$r)=split;exists$p{$l}{$r}?next:$p{$l}{$r}++;$v{$l}+=0;if($l ne$r){++$v{$r};push@{$s{$l}},$r}}@t=grep{!$v{$_}}keys%v;while(@t){print$z=pop@t;for(@{$s{$z}}){push@t,$_ unless--$v{$_}}}if(grep{$v{$_}}keys%v){die

Score: 219.42 (pass)

*sighs* Dead last and trimming strokes slowly, not nearly quick enough. I don't know if you'll see any more submissions from me because of the long holiday weekend...

#!perl -ln
($l,$r)=split;exists$p{$l}{$r}?next:$p{$l}{$r}++;$v{$l}+=0;if($l ne$r){++$v{$r};push@{$s{$l}},$r}}@t=grep{!$v{$_}}keys%v;while(@t){$_=pop@t;print;for$c(@{$s{$_}}){push@t,$c unless--$v{$c}}}if(grep{$v{$_}}keys%v){die

Score: 235.43 (pass)

Another 65 strokes... variable names > 1 char are bad... :)

#!perl -l
while(<>){($l,$r)=@l=split;exists$p{$l}{$r}?next:$p{$l}{$r}++;$r{$l}+=0;if($l ne$r){++$r{$r};push@{$s{$l}},$r}}@t=grep{!$r{$_}}keys%r;while(@t){$_=pop@t;print;for$c(@{$s{$_}}){push@t,$c unless--$r{$c}}}if(grep{$r{$_}}keys%r){exit 1}

Score: 301.38 (pass)

trimmed off 73 strokes (20%)... I'm on the board which is always nice, but I can't tell if I'll still be in the money on Sunday...

#!perl -l
while(<>){($l,$r)=@l=split;exists$pairs{$l}{$r}?next:$pairs{$l}{$r}++;$npred{$l}+=0;if($l ne$r){++$npred{$r};push@{$succ{$l}},$r}}@list=grep{!$npred{$_}}keys%npred;while(@list){$_=pop@list;print;for$child(@{$succ{$_}}){push@list,$child unless--$npred{$child}}}if(grep{$npred{$_}}keys%npred){exit 1}

Score: 374.42 (pass)

It passed the 1.6 testcase... It's a lot shorter than a lot of the adjustments that I tried to make to accomodate those silly a->a loops... It's based on code from http://www.perl.com/language/ppt/src/tsort/tcsort.html

#!perl -l
while(<>){
 my($l,$r)=my@l=split;
 next if defined $pairs{$l}{$r};
 $pairs{$l}{$r}++;
 $npred{$l}+=0;
if($l ne $r){ ++$npred{$r};
 push @{$succ{$l}},$r}}
my @list=grep{!$npred{$_}} keys %npred;
while (@list) {
 $_ = pop @list;
 print;
 foreach my $child (@{$succ{$_}}){
  unshift @list, $child unless --$npred{$child};
 }
}
if (grep {$npred{$_}} keys %npred) {
 exit 1;
}