Cod sursa(job #7806)

Utilizator hitmannCiocas Radu hitmann Data 22 ianuarie 2007 18:13:37
Problema 1-sir Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.28 kb
var st:array[1..256] of longint;
    n,i,j,k:integer;
    s,x:int64;
    as,ev:boolean;
    g:text;
procedure citire;
var f:text;
begin
assign(f,'1-sir.in'); reset(f);
read(f,n,s); close(f);
end;
procedure init;
begin
st[k]:=-2;
x:=x+st[k];
end;
procedure succesor;
begin
if k<>1 then if st[k]<n then
                        begin
                        inc(st[k]);
                        inc(x);
                        as:=true;
                        end
                        else as:=false;
end;
procedure valid;
begin
ev:=true;
if st[1]<>0 then ev:=false;
i:=2;
if abs(st[k-1]-st[k])<>1 then
                         if st[k]>=st[k-1]+2 then as:=false
                                            else ev:=false;
if k=n then if x<>s then ev:=false;
end;
begin {pp}
citire;
j:=0;
k:=2;
init;
while k>1 do
 begin
 repeat
 succesor;
 if as then valid;
 until not as or(as and ev);
 if as then if k=n then begin
                        inc(j);
                        for i:=1 to n do write(st[i],' ');
                        end
                   else begin inc(k); init; end
       else
         begin
         x:=x-st[k];
         dec(k);
         end;
       end;
assign(g,'1-sir.out');rewrite(g);
write(g,j mod 194767);
close(g);
end.