Cod sursa(job #63416)

Utilizator FreeYourMindAndrei FreeYourMind Data 28 mai 2007 16:56:42
Problema Fractii Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.83 kb
// by Freemind
// website: http://freeyourminder.spaces.live.com
// e-mail:  [email protected]

program fractii;

const fin = 'fractii.in';
     fout = 'fractii.out';
     sps : set of byte = [2,3,5,7,11,13];

var n: longint;
  ans: int64;
   fi: array[1..1000000] of longint;

procedure load;
 var f: text;
begin
 assign(f, fin); reset(f);
  read(f,n);
 close(f);
end;

function min(a,b: longint): longint;
begin
 if a<b then min:=a else min:=b;
end;

function primeof(m: longint):longint;
 var j: longint;
begin
 if m mod 2 = 0 then begin primeof:=2; exit; end;
 if m mod 3 = 0 then begin primeof:=3; exit; end;
 if m mod 5 = 0 then begin primeof:=5; exit; end;
 if m mod 7 = 0 then begin primeof:=7; exit; end;
 if m mod 11= 0 then begin primeof:=11; exit; end;
 if m mod 13= 0 then begin primeof:=13; exit; end;
 for j:=2 to trunc(sqrt(m)) div 6 do
     begin
          if m mod (6*j +1 ) = 0 then begin primeof:=6*j+1; exit; end;
          if m mod (6*j +5 ) = 0 then begin primeof:=6*j+5; exit; end;
     end;
 primeof:=m;
end;

procedure getans;
 var i,p: longint; pp: int64;
begin
 ans:=1;
 fi[1]:=1; fi[4]:=2; fi[6]:=2; fi[8]:=4; fi[9]:=6; fi[10]:=4; fi[12]:=4;
 for i:=2 to min(13,n) do
     begin
      if i in sps
         then begin
               fi[i]:=i-1;
               ans:=ans+2*fi[i];
              end
         else ans:=ans+2*fi[i];
     end;

 for i:=14 to n do
     begin
          p:=primeof(i);
          pp:=p;
          while i mod pp = 0 do
           pp:=pp*p;
          pp:=pp div p;
          if pp=i then fi[i]:=i-(i div p)
                  else fi[i]:=fi[pp]*fi[i div pp];
          ans:=ans+2*fi[i];
     end;
end;

procedure save;
 var f: text;
begin
 assign(f, fout); rewrite(f);
 write(f, ans);
 close(f);
end;

begin
 load;
 getans;
 save;
end.