Cod sursa(job #118154)

Utilizator bogdan88Bogdan Popescu bogdan88 Data 23 decembrie 2007 11:42:11
Problema Sum Scor 85
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.94 kb
var fi,fo:text;
    phi:array[1..100000]of int64;
    x:array[1..100000]of int64;
    m,i,j,max:longint;
    rez,n:int64;
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;
begin
  assign(fi,'sum.in'); reset(fi);
  assign(fo,'sum.out'); rewrite(fo);
  read(fi,m);
  max:=-maxint;
  for i:=1 to m do
    begin
      read(fi,x[i]);
      if max<x[i] then max:=x[i];
    end;
  for i:=1 to max do
    phi[i]:=i-1;
  for i:=2 to max do
     begin
       j:=i shl 1;
       while j<=max do
         begin
           phi[j]:=phi[j]-phi[i];
           j:=j+i;
         end;
     end;
  for i:=1 to m do
    begin
      rez:=x[i]*(phi[x[i]]) shl 1;
      scrie(rez);
    end;
  close(fi);
  close(fo);
end.