Cod sursa(job #72921)

Utilizator ProtomanAndrei Purice Protoman Data 15 iulie 2007 21:07:12
Problema Pascal Scor 60
Compilator fpc Status done
Runda Arhiva de probleme Marime 2.97 kb
var p,s,s1,s2,x,d,r,i,h,c:longint;
    f1,f2:text;
    v,z:array[0..50000000] of longint;

procedure putere(x:longint);
begin
        p:=1;
        s:=0;
        while p*d<=x do
        begin
                if p*d<=x then
                begin
                        p:=p*d;
                        s:=s+x div p;
                end;
                if p*d<=x then
                begin
                        p:=p*d;
                        s:=s+x div p;
                end;
                if p*d<=x then
                begin
                        p:=p*d;
                        s:=s+x div p;
                end;
                if p*d<=x then
                begin
                        p:=p*d;
                        s:=s+x div p;
                end;
                if p*d<=x then
                begin
                        p:=p*d;
                        s:=s+x div p;
                end;
                if p*d<=x then
                begin
                        p:=p*d;
                        s:=s+x div p;
                end;
                if p*d<=x then
                begin
                        p:=p*d;
                        s:=s+x div p;
                end;
                if p*d<=x then
                begin
                        p:=p*d;
                        s:=s+x div p;
                end;
        end;
end;

begin
     assign(f1,'pascal.in');
     reset(f1);
     assign(f2,'pascal.out');
     rewrite(f2);
     read(f1,r,d);
     c:=d;
     if d=4 then d:=2;
     if c<>6 then putere(r);
     if c=6 then
     begin
        d:=2;
        putere(r);
        s1:=s;
        d:=3;
        putere(r);
        s2:=s;
     end;
     inc(r);
     d:=c;
     s2:=s;
     if c<>6 then
     for i:=1 to r do
     begin
        if c=4 then d:=2;
        putere(i-1);
        v[i]:=s;
     end;
     if c=6 then
     for i:=1 to r do
     begin
         d:=3;
         putere(i-1);
         v[i]:=s;
         d:=2;
         putere(i-1);
         z[i]:=s;
     end;
     if c<>6 then
     begin
        for i:=1 to r div 2 do
        begin
                if c=4 then
                        if s2>v[i]+v[r+1-i]+1 then inc(h);
                if c<>4 then
                        if s2>v[i]+v[r+1-i] then inc(h);
        end;
        h:=h*2;
        if r mod 2=1 then
        begin
                i:=r div 2+1;
                if c=4 then
                        if s2>v[i]+v[r+1-i]+1 then inc(h);
                if c<>4 then
                        if s2>v[i]+v[r+1-i] then inc(h); end;
        end;
     if c=6 then
     begin
        for i:=1 to r div 2 do
                if (s2>v[i]+v[r+1-i])and(s1>z[i]+z[r+1-i]) then inc(h);
        h:=h*2;
        if r mod 2=1 then
        begin
                i:=r div 2+1;
                if (s2>v[i]+v[r+1-i])and(s1>z[i]+z[r+1-i]) then inc(h);
        end;
     end;
     writeln(f2,h);
     close(f1);
     close(f2);
end.