Cod sursa(job #91267)

Utilizator FoaiaFoaia de Hartie Foaia Data 11 octombrie 2007 22:09:35
Problema Pascal Scor 10
Compilator fpc Status done
Runda Arhiva de probleme Marime 2.25 kb
var f1,f2:text;
    i,j,p,r,d,c,s,s2,s3,h:longint;
    v,vt,v2,v3,vt2,vt3:array[0..5010] of longint;
begin
        assign(f1,'pascal.in');
        reset(f1);
        assign(f2,'pascal.out');
        rewrite(f2);
        read(f1,r,d);
        p:=1;
        if d=4 then
        begin
                c:=4;
                d:=2;
        end;
        if d<>6 then
        begin
                while p<=r do
                begin
                        p:=p*d;
                        j:=p;
                        while j<=r do
                        begin
                                inc(vt[j]);
                                j:=j+p;
                        end;
                end;
                for i:=1 to r+1 do
                        v[i]:=v[i-1]+vt[i-1];
        end;
        if d=6 then
        begin
                while p<=r do
                begin
                        p:=p*3;
                        j:=p;
                        while j<=r do
                        begin
                                inc(vt3[j]);
                                j:=j+p;
                        end;
                end;
                for i:=1 to r+1 do
                        v3[i]:=v3[i-1]+vt3[i-1];
                while p<=r do
                begin
                        p:=p*2;
                        j:=p;
                        while j<=r do
                        begin
                                inc(vt2[j]);
                                j:=j+p;
                        end;
                end;
                for i:=1 to r+1 do
                        v2[i]:=v2[i-1]+vt2[i-1];
        end;
        s:=v[r+1];
        s2:=v2[r+1];
        s3:=v3[r+1];
        if c<>6 then
        begin
                for i:=1 to r do
                begin
                        if c=4 then
                                if s>v[i]+v[r+1-i]+1 then inc(h);
                        if c<>4 then
                                if s>v[i]+v[r-1+i] then inc(h);
                end;
        end;
        if c=6 then
                for i:=1 to r do
                        if (s2>v2[i]+v2[r+1-i])and(s3>v3[i]+v3[r+1-i]) then inc(h);
        writeln(f2,h);
        close(f1);
        close(f2);
end.