Рекурсивная перестановка - PullRequest
Новая
       10

Рекурсивная перестановка

1 голос
/ 01 февраля 2011

Итак, я пытаюсь переставить все возможные n-значные длинные числа из x длинного массива / набора элементов.Я придумал код, который делает это, однако цифры одинаковы, как мне предотвратить это.Вот мой приход (Паскаль): 

program Noname10;

var stop : boolean;
    A : array[1..100] of integer;



function check( n : integer ) : boolean;
begin
    if n = 343 // sets the limit when to stop.
        then check := true
        else check := false;
end;


procedure permute(p,result : integer);
    var i : integer;
begin
    if not stop
        then if p = 0  then
            begin

                WriteLn(result);

                if check(result)
                    then stop := true
            end


        else for i := 1 to 9 do
            begin
                permute(p - 1, 10*result+i);
            end;


end;


begin
  stop := false;
  permute(3,0);
  readln;
end.

1 Ответ

1 голос
/ 01 февраля 2011

Вот код в прологе 

permutate(As,[B|Cs]) :- select(B, As, Bs), permutate(Bs, Cs).
select(A, [A|As], As).
select(A, [B|Bs], [B|Cs]) :- select(A, Bs, Cs).

?- permutate([a,b,c], P).

Паскаль намного сложнее.

Вот полезный алгоритм, который вы можете использовать. Но это не проверено, поэтому вы должны отладить его самостоятельно. Итак, вы должны знать, как работает алгоритм.

Алгоритм перестановки Белла: http://programminggeeks.com/bell-algorithm-for-permutation/

procedure permutate(var numbers: array [1..100] of integer; size: integer; 
                    var pos, dir: integer)
begin
  if pos >= size then
  begin
     dir = -1 * dir;
     swap(numbers, 1, 2);
  end
  else if pos < 1 then 
  begin
     dir = -1 * dir;
     swap(numbers, size-1, size);
  end
  else
  begin
     swap(numbers, pos, pos+1);
  end;
  pos = pos + dir;
end;

begin
    var a, b: integer;
    a = 1; b = 1;
    while true do
    begin
       permutate(A, 5, a, b);
       printArray(A, 5);
    end;
end.
...