Условие: Даны n чисел в произвольном порядке. Вывести на экран всевозможные их перестановки.
Технические условия: Стандартные.
Примеры входных и выходных файлов: Отсутстсуют.
Решение: {by Pavel <prog_mail@ukr.net>}
type mn=set of 1..200; var m,d,n,i: integer; s: mn; a,b: array[1..200] of integer;
procedure View; var i: integer; begin writeln; for i:=1 to n do write(b[a[i]],' '); end;
procedure Per(s: mn; k: integer); var i: integer; begin for i:=1 to n do If i in s then begin a[k]:=i; per(s-[i],k+1); end; if s=[] then view; end;
BEGIN writeln('Введите кол-во чисел'); readln(n); writeln('Введите числа'); for i:=1 to n do read(b[i]); writeln('Перестановки :'); per([1..n],1) END.
{by Antrax <antrax@mail.nnov.ru>}
{Реккурсивный алгоритм перестановок...} program Perest; type m=array[1..200] of integer; var a,b:m; i,n:integer; procedure ChangePrint; var i:integer; begin for i:=1 to n do write(b[a[i]]:3); writeln end; procedure swap(var x,y:integer); var k:integer; begin k:=x; x:=y; y:=k end; procedure Change(n:integer); var i:integer; begin if n=1 then ChangePrint else begin change(n-1); for i:=1 to n-1 do begin swap(a[n],a[i]); Change(n-1); swap(a[n],a[i]) end end end;
begin write('Введите количество чисел:'); readln(n); write('Введите числа:'); for i:=1 to n do read(b[i]); for i:=1 to n do a[i]:=i; writeln('Перестановки:'); Change(n); readln end.
*********************
{Итеративный аглоритм перебора} program change; const nmax=100; var a,b:array[1..nmax] of integer; i,n:integer; procedure Perest; var i:integer; r,l,q,p:integer; begin for i:=1 to n do a[i]:=i; for i:=1 to n do write(b[a[i]]:3); writeln; repeat l:=n-1; while (l>=1) and (a[l]>a[l+1]) do dec(l); if l>0 then begin p:=l+1; q:=n; while p<q do begin r:=a[q]; a[q]:=a[p]; a[p]:=r; inc(p); dec(q) end; for i:=l+1 to n do if a[l]<a[i] then begin r:=a[l]; a[l]:=a[i]; a[i]:=r; break end; for i:=1 to n do write(b[a[i]]:3); end; writeln; until l=0; end;
begin write('Введите количество чисел:'); readln(n); write('Введите числа:'); for i:=1 to n do read(b[i]); readln; for i:=1 to n do a[i]:=i; perest; readln; end.
