Перловые экзерсисы

[recoder]

Для домашнего проекта поставил себе задачку: по форматной строке вида "Я [сразу|немедленно] [пошёл|поехал|пополз|попёрся] разбираться с [делами|братками]." сгенерировать полный список всех возможных вариантов такой строки. Посидел с карандашиком минут 20, наваял примерно такой код:

package Xtras::Mutator;

sub new {
    my ($class,$pattern) = @_;
    my $self = bless {}, $class;

    $self->parse( $pattern ) if $pattern;

    return $self;
}

sub parse {
    my( $self, $pattern ) = @_;
    
    $pattern =~ s/\%/%%/g;
    $self->{pattern} = $pattern;
    $self->{words} = [];

    while( $self->{pattern} =~ s/\[(.*?)\]/%s/ )
    {
        push @{$self->{words}}, [ split /\|/, $1 ];
    }

    return $self->{words};
}

sub permutations {
    return make_mutes( $_[0]->{pattern}, $_[0]->{words}, [] );
}

sub make_mutes {
    my( $pat, $dict, $dat ) = @_;

        return [ sprintf( $pat, @$dat ) ] unless scalar @$dict;

    my @mutes = ();

    my $words = shift @$dict;
    push @mutes, @{ make_mutes( $pat, $dict, [ @$dat, $_ ] ) } for @$words;
    unshift @$dict, $words;

    return [ @mutes ];
}

Добравшись до компа, втоптал. И - заработало всего после двух исправлений. Старею видать... Надо посидеть помедитировать - можно ли всё это проще или изящнее изобразить? Всё-таки люблю я perl.

Comments

[vlsergey.livejournal.com]

Навеяно code_wtf?
http://community.livejournal.com/code_wtf/73670.html

[greshnik.livejournal.com]

Ну, алгоритм подбора всех возможных перестановок - не бином ньютона. Так что неудивительно, что заработало.

[larubin.livejournal.com]

Т.е. бином Ньютона не заработал бы? ;)

[recoder]

Не... Я уже вышел из возраста, когда бросаются писать то, что уже давно написано.

[russuv.livejournal.com]

помню дет так с десять назад, лежал в больнице и за неимение компа......
накатал на бумажке ;-) на ассмеблере пару листов....
при загнании в комп - на удивление все заработало.
че писал уже непомню.... но листинг был по длине достойный ;-)

[recoder]

О, я тоже пока лежал в больнице, в тетрадке сделал редизайн своего хомяка, а потом только нарисовал картинки и вбил html и скрипты...

цветной код

[jerom.livejournal.com]

#!/usr/bin/perl -l

$pattern = "Я [сразу|немедленно] [пошёл|поехал|пополз|попёрся] разбираться с [делами|братками].";

print "$_" for(@{mutate($pattern)});

sub mutate {
    my (@m, $s, $w);

    while($s = pop@_) {
        if($s =~ /\[(.*?)\]/) {

            for$w(split '\|',$1) {
                $_ = $s;

                s/\[(.*?)\]/$w/;
                push @_,$_;

            }
        } else {
            push @m, $s;

        }
    }
    return \@m;
}

[greshnik.livejournal.com]

Заработал бы. Но не сразу %)

Re: цветной код

[larubin.livejournal.com]

Что скажешь, recoder?

меня уже поправили (с pre)

[jerom.livejournal.com]

мне уже сказали, что надо быть проще и писать так:

sub mutate {
    my (@m, $s, $w);
    while($s = pop@_) {
        if($s =~ /\[(.*?)\]/) {
            push @_, map { ($w = $s) =~ s/\[.*?\]/$_/; $w } split '\|', $1;
        } else {
            push @m, $s;          
        }
    }
    return \@m;
}

Re: цветной код

[recoder]

TMTOWTDI!

Re: меня уже поправили (с pre)

[recoder]

Супер!
Всегда знал, что нет предела перловому совершенству!

вот тут с моим кодом играли

[jerom.livejournal.com]

http://community.livejournal.com/ru_perl/154645.html

угу

[jerom.livejournal.com]

gone_one:

sub mutate {{
    s/\[([^]|]*)\|?([^]]*)\]/$2 && push@_,$`."[$2]$'"; $1/e || return@_ for@_;
    redo
}}

Groking... 17%

[recoder]

Ух... Это уже где-то на грани добра и зла...

Но всё-же - какая же мощь и сила в Перле! Круче наверное только lisp да smalltalk, но там уже надо мозг напильником затачивать под них.

Re: угу

[mcsdwarken.livejournal.com]

до свиданья!
всегда Ваша,
Крыша.

Re: меня уже поправили (с pre)

[migmit.vox.com (from livejournal.com)]

quick and dirty:

> sequence_ $ map (putStrLn . concat) $ sequence $ either undefined id $ parse (many (liftM return (many1 $ noneOf "[")  <|> (between (char '[') (char ']') $ sepBy (many $ noneOf "]|") (char '|')))) "" "1[ab|c]2[qw|er|ty]"
1ab2qw
1ab2er
1ab2ty
1c2qw
1c2er
1c2ty