КАК БЕЗ РЕКУРСИИ ВЫВЕСТИ НА ЭКРАН ВСЕ ПОДСТАНОВКИ ИЗ N ЭЛЕМЕНТО В ПОРЯДКЕ УБЫВАНИЯ ЧИСЛА??
пРИМЕР ВХОД ДАННЫХ
3
вЫХОД:
321
312
231
213
132
123
Program perms;
var i,j,h,n,k:integer;
a:array[0..100] of integer; { массив для хранения перестановки }
{процедура вывода полученной перестановки}
procedure output;
var i:integer;
begin
writeln;
for i:=1 to n do write(a[i],' ');
end;
begin
readln(n); { ввод кол-ва элементов перестановки }
fillchar(a,sizeof(a),0); { инициализация массива }
{ ввод элементов начальной перестановки }
for i:=1 to n do a[i]:=i;
repeat
output; { ввод текущей перестановки }
i:=n;
while a[i-1]>a[i] do dec(i); { поиск скачка }
j:=i-1;
h:=a[j];
while a[i+1]>h do inc(i); { поиск первого меньшего элемента }
a[j]:=a[i]; a[i]:=h;
i:=j+1; k:=n;
while i<k do begin { перестановка “хвоста” }
h:=a[i]; a[i]:=a[k]; a[k]:=h;
inc(i); dec(k)
end
until j=0;
end.
Program perms;
const
max_n = 7;
fact = 5040;
type
every = array[0 .. succ(max_n)] of byte;
res_type = array[1 .. fact] of every;
var
i,j,h,n,k:integer;
a: every;
res: res_type;
count: integer;
procedure output(a: every);
var i:integer;
begin
writeln;
for i:=1 to n do write(a[i],' ');
end;
begin
readln(n);
fillchar(a,sizeof(a),0);
for i:=1 to n do a[i]:=i;
count := 0;
repeat
inc(count); res[count] := a;
i:=n;
while a[i-1]>a[i] do dec(i);
j:=i-1;
h:=a[j];
while a[i+1]>h do inc(i);
a[j]:=a[i]; a[i]:=h;
i:=j+1; k:=n;
while i<k do begin
h:=a[i]; a[i]:=a[k]; a[k]:=h;
inc(i); dec(k)
end
until j=0;
for i := count downto 1 do
output(res[i]);
end.
Program sochets;
var
i,j,n,m: integer;
a:array[0..100] of integer;
Procedure use;
var i : integer;
begin
writeln;
for i:=1 to m do write(a[i]:3)
end;
Begin
read(n, m);
for i:=0 to m do a[i]:=i;
repeat
use;
i:=m;
while a[i]=n-m+i do dec(i);
inc(a[i]);
for j:=i+1 to m do a[j]:=a[j-1]+1;
until i=0;
end.