Как я могу сгенерировать все упорядоченные комбинации длины k в Perl? - PullRequest
Новая
       1

Как я могу сгенерировать все упорядоченные комбинации длины k в Perl?

3 голосов
/ 19 января 2011

Мне нужна подпрограмма, которая при заданном наборе символов сгенерирует все возможные комбинации этих символов длины k. Заказ имеет значение, и повторное использование разрешено, поэтому, если k = 2, тогда AB != BA и AA - вариант. Я нашел несколько рабочих примеров на PerlMonks , но, к сожалению, они представляют собой код-гольф, и мне нелегко обернуться. Может кто-нибудь сделать одно или несколько из следующих действий?

  1. Дайте разбивку и объясните, как работает первый алгоритм.
  2. Де-запутать код, чтобы значение стало более понятным.
  3. Направьте меня на другой, более понятный пример.

Спасибо!

Ответы [ 2 ]

4 голосов
/ 19 января 2011

Вы можете использовать Вариации_with_repetition из Алгоритм :: Комбинаторика (который также предоставляет интерфейс на основе итераторов), но если вам просто нужен список, это довольно простой рекурсивный алгоритм: 

sub ordered_combinations
{
  my ($data, $k) = @_;

  return @$data if $k == 1;

  my @previous = ordered_combinations($data, $k-1);

  my @results;
  for my $letter (@$data) {
    push @results, map { $letter . $_ } @previous;
  }

  return @results;
} # end ordered_combinations

print "$_\n" for ordered_combinations([qw(a b c)], 3);

Это в основном тот же алгоритм, который используют игроки в коде, но я использую цикл for вместо вложения map.Кроме того, я выполняю рекурсивный анализ только один раз за уровень (гольф кода сводится к минимизации исходного кода, а не времени выполнения).

Любая рекурсивная функция может быть преобразована в итеративную, что обычно снижает ее издержки.Это довольно просто: 

sub ordered_combinations
{
  my ($data, $k) = @_;

  return if $k < 1;

  my $results = $data;

  while (--$k) {
    my @new;
    for my $letter (@$data) {
      push @new, map { $letter . $_ } @$results;
    } # end for $letter in @$data

    $results = \@new;
  } # end while --$k is not 0

  return @$results;
} # end ordered_combinations

Эта версия обрабатывает случай $k == 0, который не был в оригинале.

1 голос
/ 19 января 2011

Я посмотрел самый первый фрагмент кода на странице, на которую вы ссылались: 

sub c{my$n=-1+shift;$n?map{my$c=$_;map$c.$_,c($n,@_)}@_:@_}

Я немного разложил его, чтобы сделать его более читабельным;также я внес в него некоторые изменения, чтобы сделать его более понятным (см. combinations): 

#!/usr/bin/perl

use strict;
use warnings;

sub c {
   my $n=-1+shift;
   $n ? map{
             my $c = $_;
             map $c . $_ , c($n ,@_)
           } @_
   : @_;
}

sub combinations {
   my $number = shift; # remove the first item from @_
   my @chars  = @_;    # the remainder of @_

   $number --; # decrement $number, so that you will eventually exit
               # from this recursive subroutine (once $number == 0)

   if ($number) { # true as long as $number != 0 and $number not undef

      my @result;

      foreach my $char (@chars) {
         my @intermediate_list = map { $char . $_ } combinations($number, @chars);
         push @result, @intermediate_list;
      }

      return @result; # the current concatenation result will be used for creation of
                      # @intermediate_list in the 'subroutine instance' that called 'combinations'
   }
   else {
      return @chars;
   }
}

print join " ", combinations(2, "A", "B");
print "\n";
print join " ", c(2, "A", "B");
print "\n\n";
print join " ", combinations(3, "A", "B");
print "\n";
print join " ", c(3, "A", "B");
print "\n";

Обе версии работают одинаково и выдают одинаковый вывод: 

AA AB BA BB
AA AB BA BB

AAA AAB ABA ABB BAA BAB BBA BBB
AAA AAB ABA ABB BAA BAB BBA BBB

Я включил некоторые комментарии в код, но, возможно, более длинное объяснение в порядке !?Итак, вот пример, чтобы проиллюстрировать, как все работает: допустим, у нас есть два элемента, «A» и «B», и мы хотим получить все возможные комбинации из 2 из этих элементов.В этом случае $number первоначально будет равно 2 (как мы хотим получить пары), а @chars будет равно ('A', 'B').

Первый раз combinations называется, $number уменьшается до 1, таким образом, условие if выполняется, и мы входим в цикл foreach.Это сначала устанавливает $char в 'A'.Затем он вызывает combinations(1, ('A', 'B')).Поскольку $number всегда уменьшается при вызове подпрограммы, $number равно 0 в этой «дочерней подпрограмме», следовательно, потомок просто возвращает («A», «B»).Таким образом: 

@intermediate_list = map { $char . $_ } ('A', 'B'); # $char eq 'A'

map затем принимает оба «A» и «B» и объединяет каждый из них с «A» ($ char), таким образом, @intermediate_list - это («AA», «AB»),В следующем раунде цикла foreach то же самое делается с $char = B, который устанавливает @intermediate_list в ('BA', 'BB').

В каждом раунде содержимое @intermediate_list вставляются в список результатов, следовательно, @result в конечном итоге содержит все возможные комбинации.

Если вы хотите получить тройки вместо пар, вы, очевидно, начнете с $number = 3, и будет вызван combinationsтри раза.При втором вызове он вернет @result, то есть список, содержащий пару.Каждый элемент из этого списка будет объединен с каждым символом начального набора символов.

Хорошо, я надеюсь, что это имеет смысл.Пожалуйста, спросите, если что-то не стало ясным.

РЕДАКТИРОВАТЬ : Пожалуйста, смотрите комментарий ysth ниже.

...