Topological Sort
Score: 98.48 (pass)
This is just a minor improvement on my previous submission to remove the "die". It's a bit slow: takes about a minute on my 500MHz box.
#!perl -nal
push@{$a{pop@F}},@F}map&a,keys%a;sub a{$z eq$_||0/$.--*&a*$.++for@{$a{$z=$_}};$p{$_}++||print
|
Score: 103.48 (pass)
Gained my stroke back
#!perl -nal
push@{$a{pop@F}},@F}map&a,keys%a;sub a{$z eq$_||($.--||die,&a,$.++)for@{$a{$z=$_}};$o{$_}++||print
|
Score: 103.50 (pass)
#!perl -nal
push@{$a{pop@F}},@F}&a for%a;sub a{$z eq$_||($.--||die,&a,$.++)for@{$a{$z=$_}};$o{$_}++.ref||print
|
Score: 104.48 (pass)
This is one stroke longer than my best, but it runs 30% faster, so maybe the refs will like it better...
#!perl -nal
push@{$a{pop@F}},@F}&a for keys%a;sub a{$z eq$_||($.--||die,&a,$.++)for@{$a{$z=$_}};$o{$_}++||print
|
Score: 104.50 (fail)
#!perl -nal
push@{$a{pop@F}},@F}&a for%a;sub a{$.--<0&¨$z eq$_||&a for@{$a{$z=$_}};$.++;$o{$_}++.ref||print
|
Score: 105.48 (pass)
#!perl -nal
push@{$a{pop@F}},@F}sub a{$.--<0&¨$z eq$_||&a for@{$a{$z=$_}};$.++;$o{$_}++||print}for(keys%a){a
|
Score: 108.51 (fail)
Slow: takes just over 2 minutes on a PIII 866.
#!perl -nal
push@{$a{pop@F}},@F}sub a{$c{$_}++>2**$.&¨$z eq$_||a()for@{$a{$z=$_}};$o{$_}++.ref||print}for(%a){a
|
Score: 111.49 (pass)
Make heavy use of default var. Yahoo!
#!perl -nal
push@{$a{pop@F}},@F}sub a{$c{$_}++&¨$z eq$_||&a for@{$a{$z=$_}};$c{$_}--;$o{$_}++||print}for(keys%a){a
|
Score: 118.48 (pass)
Lucky bonus: last item in for is self, so $_ is already set (saves me two strokes)
#!perl -nal
push@{$a{$F[1]}},@F}sub a{$c{my$z=pop}++&¨$z eq$_||a($_)for@{$a{$z}};$c{$z}--;$o{$z}++||print}for(keys%a){a$_
|
Score: 120.48 (pass)
Oops, extra copy-n-paste space
#!perl -nal
sub a{$c{my$z=pop}++&¨$z eq$_||a($_)for@{$a{$z}};$c{$z}--;$o{$z}++||print$z}push@{$a{$F[1]}},@F}for(keys%a){a$_
|
Score: 121.48 (pass)
Shaving...
#!perl -nal
sub a{$c{my$z=pop}++&¨$z eq$_||a($_)for@{$a{$z}};$c{$z}--;$o{$z}++||print$z}
push@{$a{$F[1]}},@F}for(keys%a){a$_
|
Score: 124.49 (pass)
Breakthrough! At last!!!
#!perl -nal
sub a{$c{my$z=pop}++&¨$z eq$_||a($_)for@{$a{$z}};$c{$z}--;$o{$z}++||print$z}push@{$a{$F[1]}},@F}map{%c=a$_}keys%a;{
|
Score: 136.51 (fail)
#!perl -pal
sub a{($x=$n{my$z=pop})>9&¨$z eq$_||$n{$_}>$x||a($n{$_}=$x+1,$_)for@{$a{$z}}}$a{$F[1]}=[@F],a@F}for(sort{$n{$b}-$n{$a}}keys%a){
|
Score: 141.46 (pass)
The new test scripts are killing me...
#!perl -pal
sub a{$c{my$z=pop}++&¨$z eq$_||a($_)for@{$a{$z}};$c{$z}--;push@o,$z if!grep$_ eq$z,@o}push@{$a{$F[1]}},@F}map{%c=a$_}keys%a;for(@o){
|
Score: 142.49 (fail)
Reversion of my solution to pass test v1.6. I was wondering if this would happen...
#!perl -pal
sub a{($x=$n{my$z=pop})>99&¨$z eq$_||$n{$_}>$x||a($n{$_}=$x+1,$_)for@{$a{$z}}}push@{$a{$F[1]}},@F;a@F}for(sort{$n{$b}-$n{$a}}keys%a){
|
Score: 147.49 (fail)
Unlike my earlier (shorter) solutions, this one should work for any number of nodes up to the machine limit.
#!perl -pal
sub a{$c{my$z=pop}++&¨$z eq$_||$n{$_}>$n{$z}||a($n{$_}=$n{$z}+1,$_)for@{$a{$z}}}%c=push@{$a{$F[1]}},@F;a@F}for(sort{$n{$b}-$n{$a}}keys%a){
|
Score: 158.51 (fail)
oops, submitted the wrong thing last time
#!perl -pal
(grep/^$F[0]$/&&$F[1]ne$_,@{$a{$F[1]}})?die:push@{$a{$F[0]}},$F[1]}sub t{$_[0],map t($_),@{delete$a{$_[0]}}}unshift@t,grep!$c{$_}++,t(%a)while%a;for(@t){
|
Score: 158.52 (fail)
#!perl -pal
(grep/^$F[0]$/&&$F[1]ne$_,@{$a{$F[1]}})?die:push@{$a{$F[0]}},$F[1]}sub +{$_[0],map +($_),@{delete$a{$_[0]}}}unshift@t,grep!$c{$_}++,+(%a)while%a;for(@t){
|
Score: 161.51 (fail)
whittling...
#!perl -pal
push@{$a{$F[0]}},$F[1];die if grep{/^$F[0]$/&&!/^$F[1]$/}@{$a{$F[1]}}}sub t{$_[0],map{t($_)}@{delete$a{$_[0]}}}unshift@t,grep!$c{$_}++,t(%a)while%a;for(@t){
|
Score: 168.49 (fail)
Oops, had a copy-n-paste error in the previous entry
#!perl -pal
push@{$a{$F[0]}},$F[1];exit 1if grep{/^$F[0]$/&&!/^$F[1]$/}@{$a{$F[1]}}}sub t{$_[0],map{t($_)}@{delete$a{$_[0]}}}unshift@t,grep!$c{$_}++,t(keys%a)while+%a;for(@t){
|
Score: 170.50 (fail)
#!perl -pal
push@{$a{$F[0]}},$F[1];exit 1if grep{/^$F[0]$/&&!/^$F[1]$/}@{$a{$F[1]}}}sub t{$_
[0],map{t($_)}@{delete$a{$_[0]}}}unshift@t,grep!$c{$_}++,t(keys%a)while+%a;for(@
t){
|
Score: 207.49 (fail)
HARD problem!!!
#!perl -nal
$n{$F[1]}++;push@{$a{$F[0]}},$F[1];exit 1 if grep{/^$F[0]$/&&$F[0] ne$F[1]}@{$a{$F[1]}}}sub t{$_[0],map{t($_)}@{delete$a{$_[0]}}}{unshift@t,grep!$c{$_}++,t(sort{$n{$a}-$n{$b}}keys%a)while+%a;print for@t
|