Cod sursa(job #111204)

Utilizator ProtomanAndrei Purice Protoman Data 28 noiembrie 2007 20:08:47
Problema Pascal Scor 90
Compilator fpc Status done
Runda Arhiva de probleme Marime 2.55 kb
var f1,f2:text;
    i,j,p,r,d,c,s,s2,s3,h,x,t:longint;
    v,v2,v3:array[0..5000010] of longint;
begin
        assign(f1,'pascal.in');
        reset(f1);
        assign(f2,'pascal.out');
        rewrite(f2);
        read(f1,r,d);
        p:=1;
        c:=d;
        if d=4 then d:=2;
        if c<>6 then
        begin
                while p<=r do
                begin
                        p:=p*d;
                        j:=p;
                        while j<=r do
                        begin
                                inc(v[j]);
                                j:=j+p;
                        end;
                end;
                for i:=1 to r+1 do
                begin
                        x:=v[i];
                        v[i]:=v[i-1]+t;
                        t:=x;
                end;
                s:=v[r+1];
        end;
        if c=6 then
        begin
                while p<=r do
                begin
                        p:=p*3;
                        j:=p;
                        while j<=r do
                        begin
                                inc(v3[j]);
                                j:=j+p;
                        end;
                end;
                for i:=1 to r+1 do
                begin
                        x:=v3[i];
                        v3[i]:=v3[i-1]+t;
                        t:=x;
                end;
                s3:=v3[r+1];
                p:=1;
                while p<=r do
                begin
                        p:=p*2;
                        j:=p;
                        while j<=r do
                        begin
                                inc(v2[j]);
                                j:=j+p;
                        end;
                end;
                for i:=1 to r+1 do
                begin
                        x:=v2[i];
                        v2[i]:=v2[i-1]+t;
                        t:=x;
                end;
                s2:=v2[r+1];
        end;
        inc(r);
        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.