Cod sursa(job #254371)

Utilizator radupoenaruPoenaru Radu Constantin radupoenaru Data 7 februarie 2009 11:36:02
Problema Planeta Scor 0
Compilator fpc Status done
Runda Stelele Informaticii 2009, clasele 9-10, ziua 2 Marime 1.51 kb
type stiva=array[1..100] of integer;
var st:stiva;
    k,n,nr,nrr:integer;
    as,ev:boolean;
    f:text;
procedure init(var st:stiva; k:integer);
begin
st[k]:=0;
end;
procedure succesor(var st:stiva; k:integer; var as:boolean);
begin
if st[k]<n then begin
                inc(st[k]);
                as:=true;
                end
           else as:=false;
end;
procedure valid(var st:stiva; k:integer; var ev:boolean);
var i:integer;
begin
ev:=true;
for i:=1 to k-1 do
    if st[i]=st[k] then ev:=false;
end;
function solutie(k:integer):boolean;
begin
solutie:=(n=k);
end;
procedure tipar;
var i:integer;
begin
assign(f,'planeta.out');rewrite(f);
for i:=1 to n do write(st[i],' ');
close(f);
end;
begin
assign(f,'planeta.in');reset(f);
read(f,n,nrr);
close(f);
k:=1;
init(st,k);
while k>0 do begin
             repeat
             succesor(st,k,as);
             if as then valid(st,k,ev);
             until (as and ev) or (not as);
             if as then begin
                        if solutie(k) then inc(nr)
                                      else begin
                                           k:=k+1;
                                           init(st,k);
                                           end;
                         if nr=nrr then begin
                                        tipar;
                                        exit;
                                        end;
                         end
                   else k:=k-1;
              end;
end.