Cod sursa(job #465373)

Utilizator SpiderManSimoiu Robert SpiderMan Data 23 iunie 2010 23:36:08
Problema Sum Scor 85
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.79 kb
type vec = string [255] ;
var fi,fo:text;
    i,n,x,a,b,int,t,k,l:longint;
    sum:qword;
    vl,p,pr,vrf:array[1..110000] of longint;
    aa:array[1..110000] of longint;
    nmax:longint;
    y : vec;

procedure scrie(k:qword);
var i,nr:longint;
d:qword;
st:string[15];
c:array[1..15] of byte;
begin
nr:=0;
while (k>0) do
 begin
 inc(nr);
 d:=k div 10;
 c[nr]:=k-10*d+48;
 k:=d;
 end;
for i:=nr downto 1 do st[nr-i+1]:=chr(c[i]);
st[0]:=chr(nr);
writeln(fo, st);
end;

  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,rad:longint;
    begin
     p[1]:=1;
     p[2]:=0;
     rad:=trunc(sqrt(nmax));
     for i:=2 to rad do
      begin
       k:=i*i;
       while k<=nmax do
        begin
         p[k]:=1;
         k:=k+i;
        end;
      end;
      t:=1;
     for i:=1 to nmax do
      begin
       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
         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]];
      scrie(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]);
   if aa[i]>nmax then nmax:=aa[i];
  end;
 inc(nmax);
 generare;
 scor;
close(fi);
close(fo);
end.