Cod sursa(job #251090)

Utilizator MihaiBunBunget Mihai MihaiBun Data 1 februarie 2009 20:29:11
Problema Pavare2 Scor 5
Compilator fpc Status done
Runda Arhiva de probleme Marime 2.77 kb
program pava2;
var f:text;
    st,c:array[1..1000] of -1..1;
    n,a,b,i,k,j,nr,m,t,x:longint;
    nsol:array[1..100] of integer;
    as,ev:boolean;
begin
  assign(f,'pavare2.in');
  reset(f);
  readln(f,n,a,b);
  readln(f,k);
  close(f);
  assign(f,'pavare2.out');
  rewrite(f);
  j:=1;
  st[j]:=-1;
  nsol[1]:=0;
  nr:=0;
  m:=1;
  while j>0 do
  begin
    repeat
      if st[j]<1 then begin
                       st[j]:=st[j]+1;
                       as:=true
                      end
                 else as:=false;
      if as then begin
                   if st[j]=0 then begin
                                     i:=j;
                                     while (st[i]=st[j]) and(i>0) do i:=i-1;
                                     if (j-i)<=a then ev:=true
                                              else ev:=false
                                   end
                               else begin
                                     i:=j;
                                     while (st[i]=st[j])and(i>0) do i:=i-1;
                                     if (j-i)<=b then ev:=true
                                              else ev:=false
                                   end
                 end
    until(not as) or (as and ev);
    if as then if j=n then begin
                              nr:=nr+1;
                              if nsol[1]+1<=9 then nsol[1]:=nsol[1]+1
                                              else begin
                                                   nsol[1]:=0;
                                                   t:=1;
                                                   while (t<>0)and(i<m) do
                                                   begin
                                                     i:=i+1;
                                                     t:=(nsol[i]+1)div 10;
                                                     nsol[i]:=(nsol[i]+1)mod 10;
                                                   end;
                                                   if t=1 then begin
                                                                 m:=m+1;
                                                                 nsol[m]:=1
                                                               end;
                                                   end;
                              if nr=k then
                                 for i:=1 to n do
                                    c[i]:=st[i]
                           end
                      else begin
                             j:=j+1;
                             st[j]:=-1
                           end
          else j:=j-1
  end;
for i:=m downto 1 do
   write(f,nsol[i]);
   writeln(f);
for i:=1 to n do write(f,c[i],' ');
close(f);
end.