задачка на перестановки
Mar. 21st, 2007 12:27 pm"по форматной строке вида "Я [сразу|немедленно] [пошёл|поехал|пополз|попёрся] разбираться с [делами|братками]." сгенерировать полный список всех возможных вариантов такой строки"
my @ary = map { m#\[(.+?)\]# ? [ split "\\|",$1 ] : $_ } split "\\s+",$ARGV[0];
print join "\n",map { join " ",@$_ } shuffle (@ary);
exit;
sub shuffle (@) {
my $word = shift or return;
my @ary;
foreach my $w (ref $word eq "ARRAY" ? @$word : $word) {
foreach my $s (@_ ? shuffle (@_) : undef) {
push @ary,[ $w,defined ($s) && @$s ];
}
}
return @ary;
}
no subject
Date: 2007-03-21 10:49 am (UTC)А на скорость плевать, как обычно :-)
no subject
Date: 2007-03-21 10:56 am (UTC)no subject
Date: 2007-03-21 10:51 am (UTC)no subject
Date: 2007-03-21 10:55 am (UTC)no subject
Date: 2007-03-21 12:18 pm (UTC)no subject
Date: 2007-03-22 07:49 pm (UTC)my $pattern = "Я [сразу|немедленно] [пошёл|поехал|пополз|попёрся] разбираться с [делами|братками].\n"; print mutate($pattern); sub mutate {{s/\[([^]|]*)\|?([^]]*)\]/$2&&push@_,$`."[$2]$'";$1/e||return@_ for@_;redo}}Или в виде stdin-фильтра:
#!/usr/bin/perl -n @_=$_;Z:{s/\[([^]|]*)\|?([^]]*)\]/$2&&push@_,$`."[$2]$'";$1/e||print(@_)&&last Z for@_;redo}no subject
Date: 2007-03-22 09:15 pm (UTC)no subject
Date: 2007-03-22 09:37 pm (UTC)