Cod sursa(job #188886)

Utilizator antoanelaAntoanela Siminiuc antoanela Data 10 mai 2008 16:33:34
Problema Pascal Scor 80
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.17 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');
assign(g,'pascal.out');
reset(f);
rewrite(g);
read(f,r,d);
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);
    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.