Cod sursa(job #672281)

Utilizator dutzu93Vlad Vedinas dutzu93 Data 1 februarie 2012 20:27:55
Problema Pascal Scor 60
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.35 kb
var
    f,g:text;
    r,d,a,b,c1,c2,c1a,c2a,c1b,c2b,cont,i:longint;

procedure put(a:longint);
    begin
        c1:=0;
        c2:=0;
        if (d=4) then
            while (a mod 2=0) do begin
                inc(c1);
                a:=a div 2;
            end
        else if (d=6) then begin
            while (a mod 2=0) do begin
                inc(c1);
                a:=a div 2;
            end;
            while (a mod 3=0) do begin
                inc(c2);
                a:=a div 3;
            end;
        end else
            while (a mod d=0) do begin
                inc(c1);
                a:=a div d;
            end;
    end;

begin
    assign(f,'pascal.in');reset(f);
    assign(g,'pascal.out');rewrite(g);
    read(f,r,d);
    c1a:=0;c2a:=0;c1b:=0;c2b:=0;cont:=0;
    for i:=1 to r div 2 do begin
        a:=r-i+1;
        put(a);
        inc(c1a,c1);
        inc(c2a,c2);
        b:=i;
        put(b);
        put(b);
        inc(c1b,c1);
        inc(c2b,c2);
        if (d=4) then begin
            if (c1a-c1b>1) then inc(cont);
        end else if (d=6) then begin
            if (c1a>c1b) and (c2a>c2b) then inc(cont);
        end else begin
            if (c1a>c1b) then inc(cont);
        end;
    end;
    if (r mod 2=0) then write(g,2*cont-1) else write(g,2*cont);
close(f);
close(g);
end.