Cod sursa(job #26300)

Utilizator floringh06Florin Ghesu floringh06 Data 5 martie 2007 14:05:51
Problema Sum Scor 85
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.76 kb

{$IFDEF NORMAL}
  {$I-,Q-,R-,S-}
{$ENDIF NORMAL}
{$IFDEF DEBUG}
  {$I+,Q+,R+,S-}
{$ENDIF DEBUG}
{$IFDEF RELEASE}
  {$I-,Q-,R-,S-}
{$ENDIF RELEASE}


var fi,fo:text;
    i,n,x,a,b,int,t:longint;
    sum:qword;
    vl,p,pr,vrf:array[1..110000] of longint;
    aa:array[1..110000] of longint;
    nmax:longint;


  procedure Euler(m,k:longint);
    var i,j:longint;
        rez:real;
     begin
      rez:=vl[m];
      rez:=rez*(1-1/k);
      vl[m]:=trunc(rez);
     end;

  procedure generare;
   var i,j,k:longint;
    begin
     p[1]:=1;
     p[2]:=0;
     for i:=5 to nmax div 2+1 do
      begin
       k:=2*i;
       while k<=nmax do
        begin
         p[k]:=1;
         k:=k+i;
        end;
      end;
      t:=1;
     for i:=1 to nmax do
      begin
       if i mod 2=0 then
        p[i]:=1;
       if i mod 3=0 then
        p[i]:=1;
       p[2]:=0;
       p[3]:=0;
       vl[i]:=i;
       if p[i]=0 then
        begin
         pr[t]:=i;
         inc(t);
        end;
      end;
     dec(t);
{//      writeln(fo,t);   }
    end;


  procedure scor;
   var i,j,k,phi:longint;
    begin
     for i:=1 to t do
       begin
        vl[pr[i]]:=pr[i]-1;
        k:=pr[i]*2;
        while k<=nmax do
        begin
         if vrf[k]=1 then Euler(k,pr[i]);
         k:=k+pr[i];
        end;
       end;
     for i:=1 to n do
      begin
       sum:=2*aa[i];
       sum:=sum*vl[aa[i]];
       writeln(fo,sum);
      end;
    end;



begin
 assign(fi,'sum.in'); reset(fi);
 assign(fo,'sum.out'); rewrite(fo);
 readln(fi,n);
 nmax:=0;
 for i:=1 to n do
  begin
   readln(fi,aa[i]);
   vrf[aa[i]]:=1;
   if aa[i]>nmax then nmax:=aa[i];
  end;
 inc(nmax,10);
 generare;
 scor;
close(fi);
close(fo);
end.