Cod sursa(job #1089872)

Utilizator mariusadamMarius Adam mariusadam Data 21 ianuarie 2014 23:51:14
Problema Generare de permutari Scor 100
Compilator fpc Status done
Runda Arhiva educationala Marime 0.75 kb
program combinari;
var x:array[0..9] of byte;
    n,p:byte;
    f,g:text;

function cont(k:byte):boolean;
var i:byte;
begin
 cont:=true;
 for i:=1 to k-1 do
  if x[i]=x[k] then
   begin
    cont:=false;
    break;
   end;
end;

procedure afisare(k:byte);
var i:byte;
begin
 for i:=1 to k do
  write(g,x[i],' ');
 writeln(g);
end;

procedure bkt;
var k:byte;
begin
 k:=1;
 x[k]:=0;
 while k>0 do
  if x[k]<n then
   begin
    x[k]:=x[k]+1;
    if cont(k) then
     if k=n then
      afisare(k)
     else
      begin
       k:=k+1;
       x[k]:=0;
      end
   end
  else
   k:=k-1;
end;

begin
 assign(f,'permutari.in'); reset(f);
 assign(g,'permutari.out'); rewrite(g);
 readln(f,n);
 bkt;
 close(f);
 close(g);
end.