Cod sursa(job #602110)

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