Cod sursa(job #974611)

Utilizator t.g.g.tt.g.g.t t.g.g.t Data 17 iulie 2013 18:48:01
Problema Pascal Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.73 kb
var s,st,s2:longint;
    d,d2:byte;
    r,i,v:longint;
    a:array[1..5000000]of byte;
    b:array[1..5000000]of byte;

begin
  assign(input,'pascal.in'); reset(input);
  readln(r,d);
  d2:=1;
  if d=4 then begin d:=2; d2:=2 end;
  if d=6 then begin d:=2; d2:=3 end;
  v:=d;
  while v<=r do begin a[v]:=a[v div d]+1; v:=v+d; end;
  if d2>1 then begin v:=d2; end else begin s2:=1; v:=r+1; end;
  while v<=r do begin b[v]:=b[v div d2]+1; v:=v+d2 end;
  for i:=1 to r-1 do
    begin
      s:=s+a[r-i+1]-a[i];
      s2:=s2+b[r-i+1]-b[i];
      if d2=2 then begin if s>1 then st:=st+1 end else
      if (s>0) and (s2>0) then st:=st+1;
    end;
  assign(output,'pascal.out'); rewrite(output);
  writeln(st);
  close(output);
end.