Cod sursa(job #144996)

Utilizator free2infiltrateNezbeda Harald free2infiltrate Data 28 februarie 2008 11:10:06
Problema Generare de permutari Scor 80
Compilator fpc Status done
Runda Arhiva educationala Marime 0.87 kb
program permutari;
var A : array [1..8] of 1..8;
    f : text;
    n : integer;
procedure init;
begin
assign(f,'permutari.in');
reset(f);
read(f,n);
close(f);
assign(f,'permutari.out');
rewrite(f);
end;

procedure writep(p:integer);
var i : integer;
begin
for i := 1 to p do
write(f,A[i],' ');
writeln(f);
end;


function valid(p:integer):boolean;
var i,j : integer;
    ok : boolean;
begin
ok := true;
for i := 1 to p do
for j := 1 to p do
if (A[i]=A[j]) and (i<>j) then begin
                               ok := false;
                               break;
                               end;
valid := ok;
end;



procedure back(p:integer);
var pval : integer;
begin
for pval := 1 to n do begin
A[p] := pval;
if valid(p) then if p=n then writep(p)
                        else back(p+1);
end;
end;

begin
init;
back(1);
close(f);
end.