使用Perl獲取所有可能的字符串組合

Question

給定一個字符串，例如'rogerdavis'比它應該將其轉換爲'rogerd @ vis'或'rogerdav！s'或'rogerdavi $'或'rogerd @ v！$'和所有可能的組合並將其追加到文件中。所以基本上必須將'a'轉換爲'@'，'s'轉換爲'$'，'i'轉換爲'！'並使用所有可能的組合。這將在Perl中完成。

僞

• 創建一個新的文件
• 計算，A，S中出現的次數，S，I，I（或 我們只能在小或瓶蓋接受關鍵字簡化 開關盒）
• 使用組合公式計算 的可能性的總數對於總數的可能性，我們 執行替換字符a ->@，s->$， i-> I
• 添加唯一進入該文件

這是第一次在什麼來到我的腦海。請幫助我，因爲我知道有必須是一個容易和簡單的方式做這件事情：

1. 左起接受關鍵字數組的數組keyword[ ]
2. 計算長度length_of_keyword
3. 掃描陣列keyword[ ]右邊 count = 0; 爲（i = 0;我 }

4. 使用數來計算

   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

一個相當裸機實現：

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 ...

Answer 3

使用水珠（3）的多模式支持（{}）與{A，@}更換，S與{S，$}和我一起{一世！ }，如下所示：

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

如果替換字符是水珠（7）元字符，那麼它應該被轉義（3 => '\}', e => '\['，例如）。

更新：你可以運行像Data::Munge的list2re的結果替換[ASI]，FE：

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