Cod sursa(job #16672)

Utilizator petrePajarcu Alexandru-Petrisor petre Data 13 februarie 2007 20:53:32
Problema Pascal Scor 10
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.38 kb
var f,g:text;
A:array[1..500000] of longint;
n,i,j,k,l,m,p,x,y,z,nr:longint;
ok:boolean;
b:array[1..2] of byte;begin
assign(f,'pascal.in');
assign(g,'pascal.out');
reset(F);
rewrite(G);
readln(f,n,m);
k:=0;
for i:=2 to m div 2 do
        if m mod i=0 then begin
                                k:=k+1;
                                b[k]:=i;
                                m:=m div i;
                                end;  if k=0 then
                                         begin
                                         k:=k+1;
                                         b[k]:=m;
                                         end;
if m<>1 then ok:=true;x:=n;
for j:=1 to k do
begin
p:=b[k];
l:=-0;
while p<n do
        begin
        l:=l+trunc(n/p);
        p:=p*b[k];
        end;
if l<x then x:=l;
end;
if ok then x:=x div 2;nr:=0;
for i:=1 to n+1 do
         begin
         y:=n-i;
         for j:=1 to k do
begin
p:=b[k];
l:=-0;
while p<i do
        begin
        l:=l+trunc(n-i/p);
        p:=p*b[k];
        end;
if l<y then y:=l;
end;
z:=i;  if ok then y:=y div 2;
         for j:=1 to k do
begin
p:=b[k];
l:=-0;
while p<i do
        begin
        l:=l+trunc(i/p);
        p:=p*b[k];
        end;
if l<z then z:=l;
end; if ok then z:=z div 2;
a[i]:=x-y-z;
if a[i]<>0 then nr:=nr+1;
end;

writeln(g,nr);
close(F);
close(G);
end.