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

给定一个字符串，例如“rogerdavis”，则应将其转换为“rogerdavis”rogerd@vis“或者”罗杰达夫！s'或“rogerdavi$”或'rogerd@v!$' 以及所有可能的组合并将其附加到文件中。因此，基本上必须将“a”转换为“@”，将“s”转换为“$”，将“i”转换为“！”并使用所有可能的组合。这将在Perl中完成

伪代码

• 创建一个新文件
• 计算a、a、s、s、i、i（或 我们只能接受小写或大写的关键字，以简化 （开关箱）
• 计算我们可以拥有的可能性总数 使用组合公式计算可能性总数，我们 执行替换字符

  a->@

  ，

  s->$

  ，的手头工作，

  i->i

• 将唯一条目添加到文件中

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

接受数组中的关键字

关键字[]

在关键字的

length\u中计算数组的长度

从左到右扫描数组

关键字[]

计数=0； 对于（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
                 .
        }
    }
}

total_poss=0；
r=1；
新计数=计数
对于（i=count；i>0；i--）
{
//fact（）将计算阶乘
总数+=事实（新计数）/（事实（r）*事实（新计数-r））
r++；
}
对于（k=0；k我想试一试。这个问题提供了一个完美的借口


一个相当简单的实现：

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 ] );

请原谅缺少注释和错误处理（匆忙等待时间），但基本思想是，如果有n个插槽可以替换，并且假设每个插槽正好有一个可能的替代，那么就有2^n个变体（包括原始关键字）。中的位（的二进制表示）
$i
索引用于跟踪在外部循环的每次迭代中要替换的位置。因此，
$i==0
的迭代保持关键字不变。（因此，如果不希望使用此“变量”，只需将其从返回的数组中移出即可。）

这只是第一次尝试。除了注释和错误处理之外，我确信，再仔细考虑一下，这个实现可以得到显著的改进/加强

HTH…
使用glob（3）的多模式支持（{}），将a替换为{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]替换为运行的结果，如的list2re，f.e.：

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

在你的问题的标签下面有一个按钮。点击它可以修改你的问题。问题中的非换行符是怎么回事？代码格式是用于代码的，不是没有换行符的伪代码。我知道，但我无法上传它，没有格式…不管怎样，如果你想让人们阅读你的问题，有人能帮我吗在上，你让它可读。看看我自己是如何处理这类问题的。可能会展示更多的方法this@David：见鬼，写得很好。拼凑起来真是太容易了。哇！非常感谢你抽出时间从文件中帮助Glob：：Glob已经完成了任务（glob，它不再仅仅是为了匹配文件，或者从UNIX开始就不仅仅是为了匹配文件）。哇！非常感谢你抽出时间来帮助我
% perl 6995383.pl rogerDaViS
rogerDaViS
rogerD@ViS
rogerDaV!S
rogerD@V!S
rogerDaVi$
rogerD@Vi$
rogerDaV!$
rogerD@V!$

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); 

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