Cod sursa(job #48409)

Utilizator raduzerRadu Zernoveanu raduzer Data 4 aprilie 2007 19:20:32
Problema Pascal Scor 10
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.52 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
          if r>=i then
          begin
               if i=4 then b[2]:=b[2]+r div i
               else b[i]:=b[i]+r div i;
          end;
     end;
     r:=x;
     s:=0;
     for i:=1 to r+r do
     begin
          y:=i;
          x:=r-y;
          for j:=2 to 5 do c[j]:=0;
          for j:=2 to 5 do
          begin
               x:=r-y;
               if x>=j then
               begin
                    if j=4 then c[2]:=c[2]+x div j
                    else c[j]:=c[j]+x div j;
               end;
          end;
          for j:=2 to 5 do
          begin
               y:=i;
               if y>=j then
               begin
                    if j=4 then c[2]:=c[2]+y div j
                    else c[j]:=c[j]+y div j;
               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
               begin
                    q:=1;
                    break;
               end;
          end;
          if q=0 then s:=s+1;
     end;
     writeln(s);
close(output);
end.