Cod sursa(job #602107)

Utilizator ctlin04UAIC.VlasCatalin ctlin04 Data 9 iulie 2011 01:36:28
Problema Pascal Scor 50
Compilator fpc Status done
Runda Arhiva de probleme Marime 3.26 kb
program pascal_2;
 var r,d,i,k,s1,s2,s3,p,x:longint;
     o:boolean;
     fi,fo:text;
begin
 assign(fi,'pascal.in');
  reset(fi);
 assign(fo,'pascal.out');
  rewrite(fo);
 read(fi,r,d);
 for i:=0 to r div 2 do begin
  s1:=0; s2:=0; s3:=0; p:=0;
   if (d=2) or (d=4) or (d=6) then begin
                                  k:=2;
                                  while k<=r do begin
                                  s1:=s1+trunc((r)/(k));
                                  k:=k*2;
                                  end; k:=2;
                                  while k<=r-i do begin
                                   s2:=s2+trunc((r-i)/(k));
                                   k:=k*2;
                                   end;  k:=2;
                                  while k<=i do begin
                                  s3:=s3+trunc((i)/(k));
                                  k:=k*2;
                                   end;
                      if (d=2) or (d=6) then
                        if s1-(s2+s3)>0 then inc(p);
                      if d=4 then
                         if s1-(s2+s3)>=2 then inc(p);
                                                end;
            if (d=3) or (d=6) then begin
             if d=6 then begin
                          s1:=0; s2:=0; s3:=0;
                          end;
                                  k:=3;
                                  while k<=r do begin
                                  s1:=s1+trunc((r)/(k));
                                  k:=k*3;
                                  end; k:=3;
                                  while k<=r-i do begin
                                   s2:=s2+trunc((r-i)/(k));
                                   k:=k*3;
                                   end;  k:=3;
                                  while k<=i do begin
                                  s3:=s3+trunc((i)/(k));
                                  k:=k*3;
                                  end;
                      if (d=3) or (d=6) then
                            if s1-(s2+s3)>0 then inc(p);
                       if (d=6) and (p>1) then p:=1
                                           else p:=0;
                                           end;
                      if d=5 then begin
                                  k:=5;
                                  while k<=r do begin
                                  s1:=s1+trunc((r)/(k));
                                  k:=k*5;
                                  end; k:=5;
                                  while k<=r-i do begin
                                   s2:=s2+trunc((r-i)/(k));
                                   k:=k*5;
                                   end;  k:=5;
                                  while k<=i do begin
                                  s3:=s3+trunc((i)/(k));
                                  k:=k*5;
                                  end;
                        if s1-(s2+s3)>0 then inc(p);
                        end;
                        if (i=r div 2) and (p>0) then o:=true;
                        x:=x+p;
                        end;
  if r mod 2=1 then
                write(fo,2*x)
                else if o then write(fo,2*x-1)
                                  else write(fo,2*x);
close(fo);
end.