Combinações de dígitos III

Tendo já explorado as relações de conjuntos e combinações com números binários, resolvi descobrir o que podia ser feito a respeito de permutações. Infelizmente, os números binários não ajudaram muito, mas, em compensação, descobri uma propriedade interessante de uma base alternativa: a base fatorial, ou fatorádica.

A representação de um número na base fatorádica pode ser diretamente relacionada à i-ésima permutação de um conjunto, como se verá adiante. Em primeiro lugar, procurei escrever uma função para contar nessa base.

sub factoradics {
  my $n=shift;
  my $callback=shift;
  my @rest=@_;
  
  if($n==1) {
    &$callback(@rest,0);
  } else {
    factoradics($n-1, $callback, @rest, $_) for 0..$n-1;
  }
}

Essa função recebe dois parâmetros: n para o número de dígitos (que corresponderá aos número de elementos no conjunto que sofrerá as permutações) e callback para a função que será invocada a cada iteração.

A função tem uma lógica simples: na n-ésima posição, repetem-se (n-1)! vezes os digítos até o valor n-1 e, a cada iteração, faz-se o mesmo para as posições anteriores. Então, na quarta posição, repetimos 6 vezes (3!) cada um dos dígitos de 0 a 3. Na primeira posição, os dígitos são sempre iguais a zero.

Um pequeno teste mostra o que ela produz:

factoradics(4, sub {
  print "@_\n";
});

0 0 0 0
0 0 1 0
0 1 0 0
0 1 1 0
0 2 0 0
0 2 1 0
1 0 0 0
1 0 1 0
1 1 0 0
1 1 1 0
1 2 0 0
1 2 1 0
2 0 0 0
2 0 1 0
2 1 0 0
2 1 1 0
2 2 0 0
2 2 1 0
3 0 0 0
3 0 1 0
3 1 0 0
3 1 1 0
3 2 0 0
3 2 1 0

Para transformar isso em permutações há um algoritmo simples. Percorrem-se, da esquerda para a direita, os dígitos do fatorádico, usando cada um como índice para o conjunto sofrendo permutação. A cada iteração, o elemento anterior é retirado do conjunto original (por isso, o último dígito do fatorádico é sempre zero). Essa enrolação toda esta codificada na pequena função abaixo:

sub permutations {
  my $callback=shift;
  my @elements=@_;
  
  
  factoradics($#elements+1, sub {
    my @permutation;
    my @temp=@elements;
    
    push(@permutation, splice(@temp, $_, 1)) for @_;
    &$callback(@permutation);
  });
}

Como está evidente, é preciso copiar o conjunto original para uma variável temporária (@temp), já que a função precisa ir retirando (com splice) os elementos já inseridos (com push) na permutação corrente. Então, como sempre, termino com um pequeno teste para demonstrar como é fácil usar essa função:

permutations(sub{
  print "@_\n";
}, 'a','b','c');

O resultado é, conforme esperado:

a b c
a c b
b a c
b c a
c a b
c b a

A grande vantagem dessa base é que pode-se encontrar a n-ésima permutação de um conjunto sem calcular as anteriores e, mais interessante ainda, é possível determinar qual é a permutação atual. Por exemplo, com "acb" posso calcular que esta permutação corresponde ao fatorádico 010 (retira-se o primeiro elemento de "abc", depois o segundo (lembre que começamos sempre com 0) do que restou e, finalmente, o primeiro do que restou). Transformando o 010 para a base decimal, (1*1!+0*1!) descobre-se que essa é a primeira permutação de "abc".