Perl Golf на YAPC::Russia 2014

[SLY_G]

Отлично.
Осталось увидеть подробный разбор победившего решения с пояснениями.

[biophreak]

Вообще конечно решение первого места достаточно «хакерское».
Вот мой вариант.

#!/usr/bin/perl -0p
$,=$_;$_=unpack'W';$o=length$,>249;s/69/0/;s/83/1/;s/67/2-$o/e;s/73/Inf/;s/\z/\n/

[biophreak]

Даже так можно

#!/usr/bin/perl -0p
$,=$_;$_=ord$_;$o=length$,>249;s/69/0/;s/83/1/;s/67/2-$o/e;s/73/Inf/;s/\z/\n/

[biophreak]

Хотя, с unpack я намудрил конечно, там должно быть %W32 как у первого места.

[TimurN]

Ну, вообще-то, да, конечно. Но условие было, что принимаются решения, проходящие предложенный набор тестов. Да и разбирать, как оно внутри работает, в насыщенный конференционный день времени не было. Так что как есть.

Главное, что было весело. Не Олимпиада, в конце концов.

[brom_portret]

250 байт, дальше думать лень :(

#!/usr/bin/perl -l
while($d[@d] = <>){$d[-1] =~ s/(:.+)|\s//g};pop @d;

sub l{
    my $a = shift;
    my $i;
    for (@d) {
        @r = split /,/;
        if (!($i++ ~~ @_) && $a ~~ @r) {
            'Erdos' ~~ @r && push @p, $c || $a ne 'Erdos' ? @_+1 : 0;
            l($_, @_, $i-1) for grep { $_ ne $a } @r;
        }
    }
    $c++;
}

l shift @d;
print((sort@p)[0]//'Inf'

#!/usr/bin/perl -l
while($d[@d]=<>){$d[-1]=~s/(:.+)|\s//g};pop@d;sub l{my$a=shift;my$i;for(@d){@r=split/,/;if(!($i++~~@_)&&$a~~@r){'Erdos'~~@r&&push@p,$c||$a ne'Erdos'?@_+1:0;l($_,@_,$i-1)for grep{$_ ne$a}@r}}$c++}l shift@d;print((sort@p)[0]//'Inf')

[brom_portret]

все таки подумал еще, 232 байта:

while(<>) {
    ($d[@d]) = split /\n|:/;
};

sub l{
    my ($a, $i) = pop;
    for (@d) {
        @r = split /,\s/;
        if (!($i++ ~~ @_) && $a ~~ @r) {;
           'Erdos' ~~ @r && push @p, $c || $a ne 'Erdos' ? @_+1 : 0;
           $_ ne $a && l(@_, $i-1, $_) for @r;
        }
    }
    $c++;
}

l shift @d;
print((sort@p)[0]//'Inf');

#!/usr/bin/perl -l
while(<>){($d[@d])=split /\n|:/};sub l{my($a,$i)=pop;for(@d){@r=split/,\s/;if(!($i++~~@_)&&$a~~@r){'Erdos'~~@r&&push@p,$c||$a ne'Erdos'?@_+1:0;$_ ne$a&&l(@_,$i-1,$_)for@r}}$c++}l shift@d;print((sort@p)[0]//'Inf')

[brom_portret]

черт, 213 же :)

#!/usr/bin/perl -l
chomp(@d = <>);

sub l{
    my ($a, $i) = pop;
    map {
        @r = split /, |:/;
        pop @r;
        if (!($i++ ~~ @_) && $a ~~ @r) {
           'Erdos' ~~ @r && push @p, @_ || $a ne 'Erdos' ? @_+1 : 0;
           $_ ne $a && l(@_, $i-1, $_) for @r;
        }
    } @d;
}

l shift @d;
print((sort@p)[0]//'Inf');

#!/usr/bin/perl -l
chomp(@d=<>);sub l{my($a,$i)=pop;map{@r=split/, |:/;pop@r;if(!($i++~~@_)&&$a~~@r){'Erdos'~~@r&&push@p,@_||$a ne'Erdos'?@_+1:0;$_ ne$a&&l(@_,$i-1,$_)for@r}}@d}l shift@d;print((sort@p)[0]//'Inf')

[TimurN]

Да, так оно и бывает. Стоит только начать, и не остановишься.

Ваше решение, на самом деле, 196 символов (шебанг не считается), что уже вполне неплохой результат. Сходу можно снять ещё 6 символов. Дальше надо думать.

[brom_portret]

Ага, inf можно без кавычек.

[TimurN]

Да и не только Inf. ;)

[brom_portret]

ну вот, 160 :)

#!/usr/bin/perl -pla0F\n

sub R {
    my ($a, $i) = pop;
    map {
        @r = split /, |:/;
        if (!($i++ ~~ @_) & $a ~~ @r) {
           Erdos ~~ @r && push @p, @_ | $a ne Erdos ? @_+1 : 0;
           R(@_, $i - 1, $_) for @r
        }
    } @F;sort@p
}

$_=(R $F[0])[0]//Inf

#!/usr/bin/perl -pla0F\n
sub R{my($a,$i)=pop;map{@r=split/, |:/;if(!($i++~~@_)&$a~~@r){Erdos~~@r&&push@p,@_|$a ne Erdos?@_+1:0;R(@_,$i-1,$_)for@r}}@F;sort@p}$_=(R$F[0])[0]//Inf

[xtender]

Попытка раз — 126 символов:

#!/usr/bin/perl -pla0F'\n'
$c=$F[0];$p[0]='Erdos';for$i(1..$#F){@_=grep{"$_~$p[$i-1]"=~/(\b\w+\b).*~.*\1/}@F;$p[$i]="@_"=~$c?($r=$i)&&last:"@_"}$_=$r||Inf

[brom_portret]

Тесты не проходят :(
и вместо $#F можно смело писать @F :)

[xtender]

Тесты не проходят :(

только на одном тесте пробовал — сейчас сил нет :) завтра-послезавтра проверю-отлажу

и вместо $#F можно смело писать @F :)

не совсем, но я это сделал буквально через несколько минут)

$c=$F[0];$p[0]='Erdos';for(@F){$i++;@_=grep{"$_~$p[$i-1]"=~/(\b\w+\b).*~.*\1/}@F;$p[$i]="@_"=~$c?($r=$i)&&last:"@_"}$_=$r||Inf

[xtender]

еще парочка идей в голове вертится, но уже на потом оставлю…

[xtender]

таки вернулся к 126 :)

[xtender]

Вспомнил про задачку — допилил 1-е решение :)
133 символа:

#!/usr/bin/perl -pla0F'\n'

$c=$F[0];$p[0]='Erdos';for(@F){$i++;@_=grep{"$_~$p[$i-1]"=~/(\b\w+\b).*~.*\b\1\b/}@F;$p[$i]="@_"=~$c?($r=$i)&last:"@_"}$_=$r?$r-1:Inf

потом как-нибудь еще попилю)

[xtender]

131:

$c=$F[0];$p[0]='Erdos';$r=Inf;for$i(0..@F){@_=grep{"$_~$p[$i]"=~/(\b\w+\b).*~.*\b\1\b/}@F;$p[$i+1]="@_"=~$c?($r=$i)&last:"@_"}$_=$r

[xtender]

126:

#!/usr/bin/perl -pla0F'\n'

$c=$F[0];$p[0]='Erdos';$_=Inf;for$i(0..@F){@_=grep{"$_~$p[$i]"=~/(\b\w+\b).*~.*\b\1\b/}@F;$p[$i+1]="@_"=~$c?($_=$i)&last:"@_"}

[brom_portret]

1) тесты все равно не проходят, у вас должно быть в конце $i+1
2) даже если сделать предложенный фикс, будет неправильный результат для самого Эрдёша (у него должно быть 0).
3) Erdos можно не оборачивать кавычками.

Вот ваша, грубо профикшенная, программа, на который тесты проходят:

#!/usr/bin/perl -pla0F'\n'
$c=$F[0];$p[0]=Erdos;$_=Inf;for$i(0..@F){@_=grep{"$_~$p[$i]"=~/(\b\w+\b).*~.*\b\1\b/}@F;$p[$i+1]="@_"=~$c?($_=$F[0]eq Erdos ?0:$i+1)&last:"@_"}

[xtender]

А пример теста можно? По ссылке из топика все тесты проходит, поэтому я и отталкивался от этого, т.к. когда я придумал свой тест в первый раз, то половина решений из топика не проходили его.

[brom_portret]

хм, у меня вот так:

cat@lenovo:~/yr2014golf$ prove test.pl >/dev/null

#   Failed test 'Smith
# Smith, Martin, Erdos: Newtonian forms of prime factor matrices 
# Erdos, Reisig: Stuttering in petri nets
# Smith, Chen: First oder derivates in structured programming
# Jablonski, Hsueh: Selfstabilizing data structures
# '
#   at test.pl line 99.
#          got: '0
# '
#     expected: '1
# '

#   Failed test 'Chen
# Smith, Martin, Erdos: Newtonian forms of prime factor matrices 
# Erdos, Reisig: Stuttering in petri nets
# Smith, Chen: First oder derivates in structured programming
# Jablonski, Hsueh: Selfstabilizing data structures
# '
#   at test.pl line 99.
#          got: '1
# '
#     expected: '2
# '

#   Failed test 'Chen
# Smith, Martin, Erdos: Newtonian forms of prime factor matrices 
# Erdos, Reisig: Stuttering in petri nets
# Smith, Chen: First oder derivates in structured programming
# Jablonski, Hsueh: Selfstabilizing data structures
# Erdos, Chen: Close connections
# '
#   at test.pl line 99.
#          got: '0
# '
#     expected: '1
# '
# Looks like you failed 3 tests of 8.

[xtender]

что-то у нас расходится:

> cat 1.pl
#!/usr/bin/perl -pla0F'\n'

$c=$F[0];$p[0]=Erdos;$_=Inf;for$i(0..@F){@_=grep{"$_~$p[$i]"=~/(\b\w+\b).*~.*\b\1\b/}@F;$p[$i+1]="@_"=~$c?($_=$i)&last:"@_"}
>
>
> cat tests/2.txt
Smith
Smith, Martin, Erdos: Newtonian forms of prime factor matrices
Erdos, Reisig: Stuttering in petri nets
Smith, Chen: First oder derivates in structured programming
Jablonski, Hsueh: Selfstabilizing data structures
>
>
> cat tests/2.txt | ./1.pl
1 >

[brom_portret]

видимо разница в версиях интерпретатора

[xtender]

кстати спасибо про кавычки, теперь 124 :)

#!/usr/bin/perl -pla0F'\n'

$c=$F[0];$p[0]=Erdos;$_=Inf;for$i(0..@F){@_=grep{"$_~$p[$i]"=~/(\b\w+\b).*~.*\b\1\b/}@F;$p[$i+1]="@_"=~$c?($_=$i)&last:"@_"}

[xtender]

действительно оказывается у меня была ошибка копи-паста, исправил ошибку и еще сократил — теперь 108:

#!/usr/bin/perl -pla0F'\n'

$c=$F[0];$l=Erdos;$_=Inf;for$i(0..$#F){$l=$_=$i if$l=~$c;@_=grep{"$_~$l"=~/(\b\w+\b).*~.*\b\1\b/}@F;$l="@_"}

[brom_portret]

и кстати, как насчет таких тестовых данных: :)

Smith
Smith, Martin, Reisig: You got wrong Erdos Number
Erdos, Reisig: Stuttering in petri nets
Smith, Chen: First oder derivates in structured programming
Jablonski, Hsueh: Selfstabilizing data structures

[xtender]

(: именно такой тест мне пришел в голову при просмотре первого же решения и про него я и говорил в этом комментарии: habrahabr.ru/company/regru/blog/235767/#comment_7944125

[Nakilon]

Часик с Ruby одарил меня 126 символами: gist.github.com/Nakilon/7ab2120e67ed4ca036ca
В комментах ответить смогу не ранее, чем через 2 недели. Вставить код в коммент не могу по той же причине, нувывкурсе…

[xtender]

у меня пока 108 :) habrahabr.ru/company/regru/blog/235767/#comment_7946067

[xtender]

107:

#!/usr/bin/perl -pla0F'\n'

$c=$F[0];$l=Erdos;$_=Inf;for$i(0..$#F){$l=$_=$i if$l=~$c;@_=grep"$_~$l"=~/(\b\w+\b).*~.*\b\1\b/,@F;$l="@_"}

[xtender]

104:

$c=$F[0];$l=Erdos;$_=Inf;for$i(0..$#F){$l=$l=~$c?$_=$i:join" ",grep("$_~$l"=~/(\b\w+\b).*~.*\b\1\b/,@F)}

[xtender]

96:

#!/usr/bin/perl -pla0F'\n'

$l=Erdos;$l=$l=~$F[0]?$r=$_:join$\,grep{"$_~$l"=~/(\b\w+\b).*~.*\b\1\b/}@F for 0..$#F;$_=$r//Inf