Cod sursa(job #289089)

Utilizator SprzlAbcdefg Sprzl Data 26 martie 2009 13:46:33
Problema Generare de permutari Scor 100
Compilator fpc Status done
Runda Arhiva educationala Marime 0.95 kb
program permutari;
var st:array [1..10] of byte;
    i,k,n:byte;



procedure init;
begin
  st[k]:=0;
end;

function exista:boolean;
begin
  exista:=false;
  if (k<=n) and (st[k]<n) then
  begin
    exista:=true;
    inc(st[k]);
  end;
end;

function valid:boolean;
begin
  valid:=true;
  for i:=1 to k-1 do
    if st[k] = st[i] then
      valid:=false;
end;

function solutie:boolean;
begin
  solutie:=k=n;

end;

procedure tipar;
begin
  for i:=1 to k do
    write(st[i],' ');
  writeln;
end;

procedure back;
begin
  k:=1;
  init;
  while k>0 do
    if exista then
    begin
    if valid then
      if solutie then
        tipar
      else
      begin
        inc(k);
        init;
      end;
    end
    else
      dec(k);

end;

begin
  assign(input,'permutari.in');
  assign(output,'permutari.out');
  reset(input);
  rewrite(output);
  readln(n);
  back;

  close(input);
  close(output);

end.