Cod sursa(job #329083)

Utilizator ionutz32Ilie Ionut ionutz32 Data 4 iulie 2009 16:58:18
Problema Generare de permutari Scor 100
Compilator fpc Status done
Runda Arhiva educationala Marime 1.57 kb
var v:array[1..8] of 1..8;
n,i,j,a,p,q,x,fct,u:word;
f,g:text;
ok,k:boolean;
begin
assign(f,'permutari.in');
assign(g,'permutari.out');
reset(f);rewrite(g);
read(f,n);
fct:=1;
for i:=1 to n do
    begin
    v[i]:=i;
    write(g,i,' ');
    fct:=fct*i;
    end;
writeln(g);
fct:=fct-1;
for x:=1 to fct do
      begin
      i:=n;
      ok:=true;
      repeat
            for j:=v[i]+1 to n do
                begin
                k:=true;
                for a:=1 to i-1 do
                    if v[a]=j then
                       begin
                       k:=false;
                       break;
                       end;
                if k=true then
                   begin
                   ok:=false;
                   v[i]:=j;
                   p:=i;
                   for u:=1 to n do
                       begin
                       k:=true;
                       for q:=1 to i do
                           if v[q]=u then
                              begin
                              k:=false;
                              break;
                              end;
                       if k=true then
                          begin
                          p:=p+1;
                          v[p]:=u;
                          end;
                       end;
                   end;
                if ok=false then
                   break;
                end;
            i:=i-1;
      until ok=false;
      for i:=1 to n do
          write(g,v[i],' ');
      writeln(g);
      end;
close(f);close(g);
end.