Cod sursa(job #254670)

Utilizator Teodor94Teodor Plop Teodor94 Data 7 februarie 2009 13:40:14
Problema Planeta Scor 0
Compilator fpc Status done
Runda Stelele Informaticii 2009, clasele 9-10, ziua 2 Marime 1.23 kb
uses dos;
var f,g:text;
    s:array[1..100] of integer;
    d,k1,p,n,i,k,ns:longint;
    as,ev:boolean;
procedure init(k:integer);
begin
  s[k]:=0;
end;
procedure succesor(k:integer);
begin
   if s[k]<n
     then begin as:=true; s[k]:=s[k]+1; end
     else as:=false;
end;

procedure validare(k:integer);
var i:integer;
begin
  ev:=true;
  for i:=1 to k-1 do
    if s[k]=s[i] then begin ev:=false; break; end;
end;

function solutie(k:integer):boolean;
begin
  solutie:=(k=n);
end;
procedure afisare(k:integer);
begin
  ns:=ns+1;
end;
begin
  assign(f,'planeta.in'); reset(f);
  assign(g,'planeta.out'); rewrite(g);
  read(f,n,k);
  p:=1;
  for i:=2 to n do p:=p*i;
  d:=k mod p;
  if d=0 then d:=p;
  ns:=0;
  k1:=1;
  init(1);
  while k1>0 do
    begin
      repeat
        succesor(k1);
        if as then validare(k1);
      until (not as) or (as and ev);
      if as then
      if solutie(k1) then
        begin
          afisare(k1);
          if ns=d then
            begin
              for i:=1 to n do write(g,s[i],' ');
              break;
            end;
        end
                     else begin k1:=k1+1; init(k1); end
            else k1:=k1-1;
   end;
  close(f); close(g);
end.