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

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

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

Вот код в Prolog

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.