Cod sursa(job #1368448)

Utilizator guideamarinGuidea Marin guideamarin Data 2 martie 2015 17:37:31
Problema Generare de permutari Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 0.65 kb
program permut;
type p=array[0..100] of longint;
var n,i,j,d,r:longint;t,x:p;f1,f2:text;
begin
assign(f1,'per.in');assign(f2,'per.out');reset(f1);rewrite(f2);
readln(f1,n);    r:=0;
for i:=1 to n do
t[i]:=0; i:=0;
repeat

repeat
i:=i+1;
j:=1;
while t[j]=1 do j:=j+1;
x[i]:=j;
t[j]:=1;

until i=n;
for i:=1 to n do
write(f2,x[i],' ');
writeln(f2);

repeat
t[x[i]]:=0;
x[i]:=0 ;
i:=i-1;
if i<>0 then begin
if x[i]=n then  begin t[x[i]]:=0;x[i]:=0;i:=i-1;  end;
d:=x[i];
x[i]:=0;
j:=1;

repeat j:=j+1;  until ((t[j]=0)and(d<j))or(j>n);
x[i]:=j;
t[j]:=1;
t[d]:=0;   end;
until   j<=n;



until i=0;
close(f1);close(f2);
end.