Cod sursa(job #7222)

Utilizator andrei_blanaruAndrei Blanaru andrei_blanaru Data 21 ianuarie 2007 13:08:21
Problema 1-sir Scor 20
Compilator fpc Status done
Runda preONI 2007, Runda 1, Clasele 11-12 Marime 2.62 kb
const magic=194767;
type arb=^nod;
     nod=record
           un:integer;
           count:longint;
           st,dr:arb;
         end;
     lis=^elem;
     elem=record
            x:integer;
            urm:lis;
          end;
var n,s,ss:integer;
    a,b:array [-32500..32500] of arb;
    c,d:lis;

procedure baga(sum,un,cate:longint);

        procedure cauta(var k:arb);
        begin
          if k=nil
            then  begin
                    new(k);
                    k^.un:=un;
                    k^.count:=cate;
                    k^.st:=nil;
                    k^.dr:=nil;
                  end
            else  if un>k^.un
                    then  cauta(k^.dr)
                    else  if un<k^.un
                            then  cauta(k^.st)
                            else  begin
                                    k^.count:=k^.count+cate;
                                    if k^.count>magic
                                      then  k^.count:=k^.count-magic;
                                  end;
        end;

begin
  cauta(b[sum]);
end;

procedure parcurge(var k:arb);
var p:lis;
begin
  if k<>nil
    then begin
           parcurge(k^.st);
           parcurge(k^.dr);
           if b[ss+k^.un+1]=nil
             then  begin
                     new(p);
                     p^.x:=ss+k^.un+1;
                     p^.urm:=d;
                     d:=p;
                   end;
           baga(ss+k^.un+1,k^.un+1,k^.count);
           if b[ss+k^.un-1]=nil
             then  begin
                     new(p);
                     p^.x:=ss+k^.un-1;
                     p^.urm:=d;
                     d:=p;
                   end;
           baga(ss+k^.un-1,k^.un-1,k^.count);
           dispose(k);
         end;
end;

procedure prel;
var i:integer;
    p:arb;
    q:lis;
begin
  new(p);
  p^.un:=0; p^.count:=1;
  p^.st:=nil; p^.dr:=nil;
  a[0]:=p;
  new(c);
  c^.x:=0;
  c^.urm:=nil;
  for i:=2 to n do
    begin
      while c<>nil do
        begin
          ss:=c^.x;
          parcurge(a[c^.x]);
          q:=c;
          c:=c^.urm;
          dispose(q);
        end;
      c:=d;
      d:=nil;
      a:=b;
      fillchar(b,sizeof(b),0);
    end;
end;

function suma(k:arb):longint;
var s:longint;
begin
  if k=nil
    then  suma:=0
    else  suma:=(suma(k^.st)+suma(k^.dr)+k^.count)mod magic;
end;

procedure scrie;
begin
  assign(output,'1-sir.out');
  rewrite(output);
  writeln(suma(a[s]));
  close(output);
end;

begin
  assign(input,'1-sir.in');
  reset(input);
  readln(n,s);
  close(input);
  prel;
  scrie;
end.