The .02 lead seemed a bit too slim, so...
#!perl -ln0
A1:for$n(split){$c="\Q$n\E\\s";/^(?!$c).+ $c/m||s/^($c)?$c//gm&goto A.print$n}$_&&die
|
It's getting uglier and uglier, but I'm going to slip back into tenth!
#!perl -ln0
A1:for$n(split){$c="\Q$n\E\\s";/^(?!$c)\S+ $c/m||s/^($c)?$c//gm&goto A.print$n}$_&&die
|
Squeeeeeeezing...
#!perl -ln0
A1:for$n(split){$c="\Q$n\E";s/^$c $c$/$n/gm;/ $c\n/||s/^$c\s//gm&goto A.print$n}$_&&die
|
We've broken the 100 barrier! And I'm in the top 10 for what might be the first time ever.
#!perl -ln0
s/^(.+) \1$/$1/gm;A:for$n(split){$c="\Q$n\E\\s";/ $c/||s/^$c//gm&print($n)&goto A}$_&&die
|
Woo-hoo! Still got more to do...
#!perl -n0
s/^(\S+) \1$/$1/gm;
A:for$n (split){
if(!/ \Q$n\E\n/){
s/^\Q$n\E\s//gm;
print"$n\n";
goto A
}
}
$_&&die
|
Not good for my tiebreak score, but...
#!perl -nal
$p{$l}{$r}=($l,$r)=@F;$p{$r}{$r}=0}{sub z{keys%p}for(z){for$%(z){delete$p{$%},print$%if!grep$p{$_}{$%},z}}z&&die
|
Probably my limit for a while. I removed \n's for a "true" best score.
#!perl -nal
$p{$l}{$r}=($l,$r)=@F;$p{$r}{$r}=0}{sub z{keys%p}for(z){for$n(z){grep{$p{$_}{$n}}z or delete$p{$n},print$n}}%p&&die
|
If I can't get the fancy algorithm to work, I guess I'll try fixing the old one. It does put me ahead a few spots. But it seems clear I need yet another another new algorithm.
#!perl -nal
($l,$r)=@F;
$p{$l}{$r}=1;$p{$r}{$r}=0
}
{
for(keys%p){
for$n(keys%p){
grep{$p{$_}{$n}}keys%p or delete$p{$n},print$n
}
}
%p&&die
|
Use -na with }{ trick. I fear this algorithm is nearing its end, though...
#!perl -nal
($l,$r)=@F;
$p{$l}{$r}=$p{$r}{$r}=1
}
{
for(keys%p){
for$n(keys%p){
grep{$_ ne$n&&$p{$_}{$n}}keys%p or delete$p{$n},print$n
}
}
%p&&die
|
This is It! The One True Algorithm! This version is still somewhat readable; let's work on that.
#!perl -n0
s/^(\S+) \1$/$1/gm;
$a=1;
while ($a--) {
for $node (split) {
if (!/ \Q$node\E\n/) {
s/^\Q$node\E\s//gm;
print "$node\n";
$a=1;
last
}
}
}
die if $_
|
YAAWWPGMN (Yet another algorithm which will probably get me nowhere.)
#!perl -pal
@a{($l,$r)=@F}=@F;
$p{$r}{$l}=1if$l ne$r
}
while(($n)=grep!%{$p{$_}},%a){
delete$p{$_}{$n}for%p;
delete$a{$n};
print$n
}
for(keys%a){%{$p{$_}}&&die
|
Ha! I've caught up to Andrew! Too bad this algorithm is going nowhere.
#!perl -l
while (<>) {
($l,$r)=split;
$p{$l}{$r}=$p{$r}{$r}=1
}
for(keys%p) {
for$n(keys%p) {
grep{$_ ne$n&&$p{$_}{$n}} keys%p or delete $p{$n},print$n
}
}
die if %p
|
Hm. This new algorithm was supposed to gain me more ground...
#!perl -nal
($l,$r)=@F;
$p{$l}+=0;
$p{$r}++if$r ne$l&&!$c{$l}{$r}++
}
sub z{grep{!$p{$_}}@a=keys%p}
@o=z;
while(defined($_=pop@o)){
print;
push@o,grep{!--$p{$_}}keys%{$c{$_}}
}
die if z!=@a;
{
|
A bit shorter without the niceties. But is this shortenable by 150 or so? I doubt it.
#!perl
while (<>) {
($l, $r) = split;
$pairs{$l}{$r} = 1;
$pairs{$r}{$r} = 1;
}
for (keys %pairs) {
for $node (keys %pairs) {
next if (grep {$pairs{$_}{$node}} keys %pairs) - !!$pairs{$node}{$node};
print "$node\n";
delete $pairs{$node};
}
}
die if %pairs;
|
This is the easy part...
#!perl
$str = join"",<>;
1 while $str =~ s/^(\S+) \1$/$1/gm;
while ((($parent)=grep {!($str=~/ \Q$_\E$/m)} $str =~ /^(\S+) /gm)) {
$str =~ s/^\Q$parent\E( (\S+)|\n)/$2/gme and print "$parent\n";
}
for($str=~/(\S+)/g){print "$_\n" unless $a{$_}++}
exit 1 if $str =~/ /;
|
Ready or not, here I come!
#!perl -nal
($p, $c) = @F;
$parent{$p}+=0;
$parent{$c}++ if $c ne $p && !$child{$p}{$c}++
}
sub gr{grep{!$parent{$_}}@all=keys%parent}
@orphan = gr;
while (defined($_ = pop @orphan)) {
print;
push @orphan, grep{!--$parent{$_}} keys %{$child{$_}}
}
die if gr!=@all;
{
|
Yet another another algorithm. This one stolen indirectly from Knuth.
#!perl -nal
($p, $c) = @F;
$parent{$p}+=0;
next if $c eq $p;
$parent{$c}++ if !$child{$p}{$c}++
}
sub gr{grep{!$parent{$_}}@all=keys%parent}
@orphan = gr;
while (defined($node = pop @orphan)) {
print "$node";
for $kid (keys %{$child{$node}}) {
$parent{$kid}--;
push @orphan, $kid if !$parent{$kid}
}
}
die if gr!=@all;
{
|
And so it begins...
#!perl -w
use strict;
my $str = join"",<>;
my $parent;
my $count;
# remove self-rules
1 while $str =~ s/^(\S+) \1$/$1/gm;
# While there's a parent with no parents, print it and get rid of it
while ((($parent)=grep {!($str=~/ \Q$_\E$/m)} $str =~ /^(\S+) /gm)) {
$str =~ s/^\Q$parent\E( (\S+)|\n)/$2||""/gme and print "$parent\n";
$count++;
}
# Print remaining children
my %a =map {$_,1} $str=~/(\S+)/g;
print join("\n",keys %a),"\n";
exit 1 if $str =~/ /;
|
Totally different algorithm, stolen from a web CS class. Shortenable?
#!perl -w
use strict;
my %pairs;
while (<>) {
my ($l, $r) = split;
# If it has children, set them. Otherwise, make a self-link
$pairs{$l}{$r} = 1;
$pairs{$r}{$r} = 1;
}
# Try n times
for (keys %pairs) {
# Find nodes without parents (self-link doesn't count as a parent)
for my $node (keys %pairs) {
# Node has more parents than just itself. Scalar grep is # of parents
next if (grep {$pairs{$_}{$node}} keys %pairs) - !!$pairs{$node}{$node};
print "$node\n";
delete $pairs{$node}; # Node is no longer a parent
}
}
# If anything is left, we couldn't get rid of all nodes: cycle!
die "cycle" if %pairs;
|