Cod sursa(job #48390)

Utilizator raduzerRadu Zernoveanu raduzer Data 4 aprilie 2007 18:57:10
Problema Pascal Scor 20
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.33 kb
var a,b,c:array[1..5]of integer;
    r,d,s,i,j,x,y,q,z:longint;
begin
     assign(input,'pascal.in');
     reset(input);
     assign(output,'pascal.out');
     rewrite(output);
     readln(r,d);
     for i:=2 to d do
     begin
          while d mod i =0 do
          begin
               a[i]:=a[i]+1;
               d:=d div i;
          end;
     end;
     x:=r;
     for i:=2 to 5 do
     begin
          while r mod i=0 do
          begin
               b[i]:=b[i]+1;
               r:=r div i;
          end;
     end;
     r:=x;
     s:=0;
     for i:=1 to r+1 do
     begin
          y:=i;
          x:=r-y;
          for j:=2 to 5 do c[j]:=0;
          for j:=2 to 5 do
          begin
               while (x mod j=0)and(x>0) do
               begin
                    c[j]:=c[j]+1;
                    x:=x div j;
               end;
          end;
          for j:=2 to 5 do
          begin
               while (y mod j=0)and(y>0) do
               begin
                    c[j]:=c[j]+1;
                    y:=y div i;
               end;
          end;
          q:=0;
          for j:=2 to 5 do
          begin
               if a[j]=0 then continue;
               if a[j]>b[j]-c[j] then q:=1;
          end;
          if q=0 then s:=s+1;
     end;
     writeln(s);
close(output);
end.