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
clrscr;
write('количество элементов перестановки: '); 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;
readkey;
end.
Program perms;
uses crt;
var
i, j, h, n, k: integer;
a:array[0 .. 100] of integer; { ìàññèâ äëÿ õðàíåíèÿ ïåðåñòàíîâêè }
out,:text;
{ïðîöåäóðà âûâîäà ïîëó÷åííîé ïåðåñòàíîâêè}
procedure output;
var i: integer;
begin
writeln;
for i:=1 to n do write(a[i],' ');
end;
begin
clrscr;
assign(out,'c:\ out.txt');
rewrite (out);
write('êîëè÷åñòâî ýëåìåíòîâ ïåðåñòàíîâêè: '); 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);
write(out,'kombinacii');
end
until j=0;
close(out);
end.
Program perms;
uses crt;
var
i, j, h, n, k: integer;
a:array[0 .. 100] of integer; { массив для хранения перестановки }
out:text;
{процедура вывода полученной перестановки}
procedure output;
var i: integer;
begin
writeln;
for i:=1 to n do write(a[i],' ');
end;
begin
clrscr;
assign(out,'c:\out.txt');
rewrite (out);
write('количество элементов перестановки: '); 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);
write(out);
end
until j=0;
close(out);
end.
{процедура вывода полученной перестановки}, тогда будет запись в файл... Кстати, я бы не рекомендовал бросать файлы в корень диска С:... Во-первых, у тебя элементарно может не быть прав на запись туда, а во-вторых - это просто глупо, зачем писать что-то в корень системного диска? Пиши в ту же папку, где лежит твой EXE-шник:
procedure output;
var i: integer;
begin
writeln(out); { <--- }
for i:=1 to n do write(out, a[i],' '); { <--- }
end;
clrscr;
assign(out,'out.txt');
rewrite (out);