Получение всех возможных комбинаций строк с Perl

Question

Учитывая строку, например, 'rogerdavis', чем она должна преобразовать ее в 'rogerd @ vis' или 'rogerdav! S' или 'rogerdavi $' или 'rogerd @ v! $' И все возможные комбинации и добавить ее вфайл.Так что в основном нужно преобразовать 'a' в '@', 's' в '$' и 'i' в '!'и использовать все возможные комбинации.Это должно быть сделано в Perl.

Псевдокод

• Создать новый файл
• Рассчитать количество вхождений a, A, s, S, i, I (или мы можем принять ключевое слово только маленькими или заглавными буквами, чтобы упростить случай переключения)
• Рассчитать общее количество возможностей, которое мы можем иметь, используя формулу комбинаций. Для общего числа возможностей, которые мы выполняемработа по замене символов a ->@, s->$, i-> I
• добавление уникальной записи в файл

Это то, что пришло мне в голову вначале.Пожалуйста, помогите мне, потому что я знаю, что должен быть простой и легкий способ сделать это:

1. Принять ключевое слово в массиве keyword[ ]
2. Рассчитать длину массива в length_of_keyword
3. Сканирование массива keyword[ ] слева направо отсчет = 0;for (i = 0; i}

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

Используйте поддержку множественных шаблонов 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] результатами запуска что-то вроде 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 из его возвращенного массива.)

Это всего лишь первая трещина в этом. В дополнение к комментариям и обработке ошибок, я уверен, что если немного подумать, эту реализацию можно значительно улучшить / ужесточить.

НТН ...