Cod sursa(job #657147)

Utilizator dady95bogdan david dady95 Data 5 ianuarie 2012 20:22:19
Problema Generare de permutari Scor 100
Compilator fpc Status done
Runda Arhiva educationala Marime 1.51 kb
program info;
var n,i,k:integer;
    x:array[1..10]of integer;
    f,g:text;


procedure citire;
    BEGIN
       assign(f,'permutari.in');
       reset(f);
       assign(g,'permutari.out');
       rewrite(g);
       read(f,n);
    END;

procedure init(k:integer);
    BEGIN
       x[k]:=0;
    END;

function exista(k:integer):boolean;
    BEGIN
       exista:=(x[k]<n);
    END;

function cont(k:integer):boolean;
var i:integer;
    BEGIN
       cont:=true;
       for i:=1 to k-1 do
           if x[i]=x[k] then
              cont:=false;
    END;

function solutie(k:integer):boolean;
    BEGIN
       solutie:=(k=n);
    END;

procedure tipar(k:integer);
var i:integer;
    BEGIN
       for i:=1 to k do
           write(g,x[i],' ');
       writeln(g);
    END;

procedure bkt;
var k:integer;
    BEGIN
       k:=1;
       init(k);
       while k>0 do
             if exista(k) then
                BEGIN
                   x[k]:=x[k]+1;
                   if cont(k) then
                      if solutie(k) then
                         tipar(k)
                                    else
                         BEGIN
                            k:=k+1;
                            init(k);
                         END;
                END
                          else
                k:=k-1;
    END;

procedure inchide;
    BEGIN
       close(f);
       close(g);
    END;

BEGIN
   citire;
   bkt;
   inchide;
END.