Question

给出一个字符串例如'rogerdavis'，它应该将它转换为'rogerd @ vis'或'rogerdav！s'或'rogerdavi $'或'rogerd @ v！$'以及所有可能的组合并将其附加到文件。所以基本上必须将'a'转换为'@'，将's'转换为'$'，将'i'转换为'！'并使用所有可能的组合。这将在Perl中完成。

伪代码

创建新文件
计算a，A，s，S，i，I（或者）的出现次数我们只接受小字或大写字母的关键字来简化开关盒）
计算我们可以拥有的可能性总数使用组合公式我们可能的总数执行替换字符a ->@，s->$的工作， i-> I
为文件添加唯一条目

这是我最初想到的。请帮助我，因为我知道必须有一个简单而简单的方法来做这件事：

接受数组keyword[ ]
计算length_of_keyword
从左到右扫描数组keyword[ ] count = 0; for（i = 0; i }

使用count来计算可能性总数

total_poss =0;
r= 1;
new_count = count
for (i = count; i > 0; i--)
{
    // fact( ) will calculate factorial
    total_poss += fact(new_count)/(fact(r)*fact(new_count - r))  
    r++;
 }

for (k=0; k<total_poss; total_poss++)
   copy array keyword[ ] in temporary array temp[ ];
   for (i=0; i< new_count; i++)
   {

       for (j = 0; j< lenght_of_keyword; j++)
       {
           if (temp[i] is equal to 'a' || 'A' || 's' || 'S' || 'i' || 'I' )
           {
               switch (temp[j])

                   case i: tempt[i] = ! ;
                              if ( modified array is equal to an entry in file)
                                  continue;
                              else save in file; break;
                   case I: (same as above or we can have function for above code)
                 .
                 .// similarly for all cases
                 .
        }
    }
}

Answer 1

我想给List::Gen一个旋转。这个问题提供了完美的借口！

use strict;
use warnings;
use List::Gen;

my %symbol = ( a => '@', A => '@',
               i => '!', I => '!',
               s => '$', S => '$', );  # Symbol table

my $string = 'rogerdavis';
my @chunks = split /(?<=[ais])|(?=[ais])/i, $string;

# Turn into arrayrefs for cartesian function

@chunks = map { $_ =~ /^[ais]$/i ? [ $_, $symbol{$_} ] : [ $_ ] } @chunks;

my $cartesian = cartesian { join '', @_ } @chunks;  # returns a generator

say for @$cartesian;  # or 'say while < $cartesian >'

<强>输出

rogerdavis
rogerdavi$
rogerdav!s
rogerdav!$
rogerd@vis
rogerd@vi$
rogerd@v!s
rogerd@v!$

Answer 2

使用glob（3）的多模式支持（{}），将{a，@}，s替换为{s，$}，将i替换为{i，！}，如下所示：

my $str = 'rogerdavis';
my $glob = $str;
# set up replacement character map
my %replacements = (a => '@', s => '$', i => '!');
# add uppercase mappings
$replacements{uc $_} = $replacements{$_} for keys %replacements;
# replace 'character' with '{character,replacement}'
$glob =~ s/([asi])/{$1,$replacements{$1}}/ig;
my @list = glob($glob);
print join "\n", @list;
print "\n";
my $count = scalar(@list);

如果替换字符是glob（7）元字符，那么它应该被转义（例如3 => '\}', e => '\['）。

更新：您可以将[asi]替换为运行类似Data::Munge的list2re，f.e。的结果：

my $re = Data::Munge::list2re(keys %replacements);
$glob =~ s/($re)/{$1,$replacements{$1}}/ig;

Answer 3

相当简单的实施：

sub convert {
  my $keyword = shift @_;
  my $map = @_ ? $_[ 0 ] : \%MAP;
  my @parts = do {
    my $regex = do {
            my $letters = join('', keys %$map);
            qr/([$letters])/i;
    };
    split($regex, $keyword, -1);
  };
  my $n_slots = ( -1 + scalar @parts )/2;
  my $n_variants = 2 ** $n_slots;
  my @variants;
  my $i = 0;  # use $i = 1 instead to keep the original $keyword                                                          
              # out of the list of variants                                                                               
  while ( $i < $n_variants ) {
    my @template = @parts;
    my $j = 1;
    my $k = $i;
    for ( 1 .. $n_slots ) {
      $template[ $j ] = $map->{ lc $parts[ $j ] } if $k & 1;
      $j += 2;
      $k >>= 1;
    }
    push @variants, join( '', @template );
    $i++;
  }

  return \@variants;
}

sub main {
  my $keyword = shift @_;
  my $fh = @_ ? ( open( $_[ 0 ], 'a' ) or die $! ) : \*STDOUT;
  print $fh "$_\n" for @{ convert( $keyword ) };
}

main( $ARGV[ 0 ] );

示例运行：

% perl 6995383.pl rogerDaViS
rogerDaViS
rogerD@ViS
rogerDaV!S
rogerD@V!S
rogerDaVi$
rogerD@Vi$
rogerDaV!$
rogerD@V!$

原谅缺乏评论和缺乏错误处理（赶时间），但基本的想法是，如果有n个插槽可以更换，并假设每个插槽只有一个可能的替代品，那么有2 ^ n个变种（包括原始关键字）。 $i索引的（二进制表示）中的位用于跟踪在外循环的每次迭代中要替换的位置。因此，$i == 0的迭代使关键字保持不变。（因此，如果您不想要这个“变体”，只需将shift从返回的数组中删除。）

这只是第一次破解。除了评论和错误处理之外，我确信，通过更多的思考，这个实现可以得到显着改善/收紧。

... HTH

使用Perl获取所有可能的字符串组合

3 个答案: