Cod sursa(job #461412)

Utilizator hunter_ionutzzzFarcas Ionut hunter_ionutzzz Data 6 iunie 2010 18:24:36
Problema Fractii Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.85 kb
program fractii;
type ta=array[1..1000000] of 0..1;
     ta2=array[1..1000000] OF int64;
var fin,fout:text;
    d,suma,n,cop,p:int64;
    i,j:longint;
    a:ta ;
    t:ta2 ;
begin {pp}
assign(fin,'fractii.in');reset(fin);
assign(fout,'fractii.out');rewrite(fout);
read(fin,n);
close(fin);
    for i:=2 to n do
       if a[i]=0 then
          for j:=2 to (n div i) do
              a[i*j]:=1;
    suma:=1;
for i:=1 to n do
    begin
    if a[i]=0 then
        t[i]:=i-1
    else begin
    d:=2;
    while i mod d<>0 do
          d:= d+ 1;
    p:=1;
    cop:=i;
    while cop mod d=0 do
        begin
           cop:=cop div d;
           p:=p*d;
        end;
        if cop=1 then t[i]:=i-(i div d)
             else t[i]:=t[p]*t[cop];
        end;
    suma:=suma+t[i];
    end;
    write(fout,2*suma-1);
    close(fout);
end.