Topological Sort
Score: 84.46 (pass)
My program fits on one line! Well, besides the #!perl line, anyway.
#!perl -ln0
s/^(.*) \1$/$1/mg;s!.!/ \Q$&
/||(print$&)&s/^\Q$&\E\s//mg&redo while/\S+/g;&a!e
|
Score: 85.51 (pass)
Finally got rid of that dang $t, and now the program almost fits on one line. I can feel more strokes here to be shaved.
#!perl -ln0
s/^(.*) \1$/$1/mg;/./&&${/ \Q$&
/||(print$&)&s/^\Q$&\E\s//mg&redo while/\S+/g}/0
|
Score: 86.50 (pass)
Continuing the variation on a theme. I have a feeling this may be my last improvement for a while...
#!perl -ln0
s/^(.*) \1$/$1/mg;/ \Q$&
/||($t=print$&)&s/^\Q$&\E\s//mgwhile/\S+/g;///$t--&&redo
|
Score: 88.50 (pass)
Okay, now we'll do illegal division by zero. How many ways can we get perl to die? ;-)
#!perl -ln0
s/^(.*) \1$/$1/mg;/ \Q$&
/||($t=print$&)&s/^\Q$&\E\s//mgwhile/\S+/g;1/$t--,//&&redo
|
Score: 89.50 (pass)
Changed 'die' to &a (undefined sub). I've tried three completely different approaches and this one's still worked the best, but I'm not so confident in it anymore.
#!perl -ln0
s/^(.*) \1$/$1/mg;/ \Q$&
/||($t=print$&)&s/^\Q$&\E\s//mgwhile/\S+/g;$t--?//&&redo:&a
|
Score: 90.49 (pass)
Ditched the outer while loop for a 3 stroke gain. Yay!
#!perl -ln0
s/^(.*) \1$/$1/mg;/ \Q$&
/||($t=print$&)&s/^\Q$&\E\s//mgwhile/\S+/g;$t--?//&&redo:die
|
Score: 93.49 (pass)
None of my other algorithms have panned out, so I'll just keep pushing parentheses around...
#!perl -ln0
s/^(.*) \1$/$1/mg;${/ \Q$&
/||($t=print$&)&s/^\Q$&\E\s//mgwhile/\S+/g;$t--||die}while/./
|
Score: 95.50 (pass)
Except for the obvious improvement of removing unnecessary /m modifiers, I've hit a wall.
#!perl -ln0
s/^(.*) \1$/$1/mg;${/ \Q$&
/||s/^(\Q$&\E)\s//mg&($t=print$1)while/\S+/g;$t--||die}while/./
|
Score: 97.49 (pass)
Inching closer...
#!perl -ln0
s/^(.*) \1$/$1/mg;${/ \Q$&
/m||s/^(\Q$&\E)\s//mg&($t=print$1)while/\S+/mg;$t--||die}while/./
|
Score: 99.53 (pass)
Yay! Broke 100!
#!perl -ln0
${/^(?!\Q$&\E ).* \Q$&
/m||s/^(\Q$&\E)( \1)?\s//mg&($t=print$1)while/\S+/mg;$t--||die}while/./
|
Score: 102.53 (pass)
More small improvements, hoping for the big one...
#!perl -ln0
${/^(?!\Q$&\E ).* \Q$&\E$/m||s/^(\Q$&\E)( \1)?\s//mg&&($t=print$1)while/\S+/mg;$t--||die}while/./
|
Score: 106.54 (pass)
Got rid of a few parens and braces... now to get rid of $t.
#!perl -ln0
${$t=0;/^(?!\Q$&\E ).* \Q$&\E$/m||s/^(\Q$&\E)( \1)?\s//mg&&++$t&&print$1while/\S+/mg;$t||die}while/./
|
Score: 110.53 (pass)
#!perl -ln0
${$t=0;for$m(/^\S+/mg){/^(?!\Q$m\E ).* \Q$m\E$/m||s/^(\Q$m\E)( \1)?\s//mg&&++$t&&print$m}$t||die}while/./
|
Score: 111.53 (pass)
I think a regex is the way to go for this one. But it's dang hard to construct! (This isn't it:-)
#!perl -ln0
while(/./){$t=0;for$m(/^\S+/mg){/^(?!\Q$m\E ).* \Q$m\E$/m||s/^(\Q$m\E)( \1)?\s//mg&&++$t&&print$m}$t||die}
|
Score: 121.51 (fail)
Regex solutions kick butt. I think this one can be improved greatly.
#!perl -ln0
print$1while s/^(\S+) \1$//m;while(/\S/){$t=0;for$m(/^\S+/mg){/ \Q$m\E$/m||s/^\Q$m\E[
]//mg&&++$t&&print$m}$t||die}
|
Score: 126.49 (pass)
#!perl -ln
/ /,$`ne$'&&$b{$'}{$`}++;$b{$`}{0}}while(%b){delete@b{@k=grep!%{$b{$_}}&&print,keys%b}or die;delete@{$b{$_}}{@k}for keys%b
|
Score: 131.49 (pass)
More minor improvements... I need something less cumbersome than a HoH, methinks.
#!perl -ln
/ /,$`ne$'&&$b{$'}{$`}++;$b{$`}{0}}while(%b){delete@b{@k=grep!%{$b{$_}},keys%b}or die;delete@{$b{$_}}{@k}for keys%b;print for@k
|
Score: 136.47 (pass)
#!perl -ln
/ /,$`ne$'&&$b{$'}{$`}++;$b{$`}{0}}while(%b){delete@b{@k=grep{!keys%{$b{$_}}}keys%b}or die;delete@{$b{$_}}{@k}for keys%b;print for@k
|
Score: 140.47 (pass)
#!perl -lna
/ /&&$`ne$'&&$b{$'}{$`}++;$b{$`}||={}}while(%b){delete@b{@k=grep{!keys%{$b{$_}}}keys%b}or die;delete@{$b{$_}}{@k}for keys%b;print for@k
|
Score: 147.45 (pass)
The solution still looks big and gross, but it's time for bed.
#!perl -lna
($j,$k)=@F;$b{$k}{$j}=1if$j ne$k;$b{$j}||={}}while(%b){delete@b{@k=grep{!keys%{$b{$_}}}keys%b}or die;delete@{$b{$_}}{@k}for keys%b;print for@k
|
Score: 153.44 (pass)
Not bad for 40 minutes' work, I suppose. Lots of easy improvements, and probably many more to be made.
#!perl -lna
($j,$k)=@F;$b{$k}{$j}=1if$j ne$k;$b{$j}||={}}while(%b){@k=grep{!keys%{$b{$_}}}keys%b;@k||die;delete@b{@k};delete@{$b{$_}}{@k} for keys%b;print for@k
|
Score: 181.00 (pass)
Boy, it's not at all pretty, but it's a first shot.
#!perl -l
while(<>){($j,$k)=split;$j ne$k&&($b{$k}{$j}=1);$b{$j}||={}}while(%b){@k=grep{keys%{$b{$_}}==0}keys%b;exit(-1)if!@k;delete @b{@k};for$k(keys%b){delete$b{$k}{$_}for@k}print for@k}
|