Cod sursa(job #411472)

Utilizator krissu93FMI Tiugan Cristiana Elena krissu93 Data 4 martie 2010 22:03:46
Problema Generare de permutari Scor 100
Compilator fpc Status done
Runda Arhiva educationala Marime 1.43 kb
type vector=array[1..8] of byte;
var  f:text;
     st:vector;
     k,n,i:integer;
     ass,ev:boolean;
procedure init(var k:integer; var st:vector);
begin
 st[k]:=0;
end;
procedure  succ(k:integer;var st:vector; var ass:boolean);
begin
if st[k]<n then begin
                      st[k]:=st[k]+1;
                      ass:=true;
                end
           else ass:=false;
end;
procedure valid(k:integer;st:vector;var ev:boolean);
var i :integer;
begin
 ev:=true;
 for i:=1 to k-1 do
  if st[i]=st[k] then begin ev:=false;
                            break;
                      end;
end;
function solutie(k:integer;st:vector):boolean;
begin
 if k=n then solutie:=true
        else solutie:=false;
end;
begin
assign(f,'permutari.in');
reset(f);
readln(f,n);
k:=1;
init(k,st);
close(f);
assign(f,'permutari.out');
rewrite(f);
while k>0 do
begin
      repeat
      succ(k,st,ass);
      if ass then valid(k,st,ev)
      until (ass and ev) or (not ass);
      if ass then
                  if solutie(k,st) then begin
                                    for i:=1 to n do
                                      write(f,st[i],' ');
                                      writeln(f);
                                  end
                             else begin inc(k);
                                        init(k,st);
                                  end
             else dec(k);
end;
close(f);
end.