Cod sursa(job #465372)

Utilizator SpiderManSimoiu Robert SpiderMan Data 23 iunie 2010 23:30:39
Problema Sum Scor 90
Compilator fpc Status done
Runda Arhiva de probleme Marime 2.71 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;

 function parse ( var x : vec ; var a : longint ) : longint ;
    var i , y : longint;

    begin
            i := a; y := 0;

            while (i <= k) do
                begin
                    if ( x[i] >= '0' ) and ( x[i] <= '9' ) then
                        y := y * 10 + ord(x[i]) - 48
                    else
                        begin
                            if ( i = 255 ) then
                                begin
                                    a := 1 ; i := 0;
                                    read ( fi, x ) ;
                                    k := length ( x ) ;
                                end ;
                            inc ( i ) ;
                            break;
                        end;

                    if ( i = 255 ) then
                         begin
                              a := 1 ; i := 0;
                              read ( fi, x ) ;
                              k := length ( x ) ;
                         end ;

                    inc ( i ) ;

                end;

           a := i;
           parse := y;
  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]];
       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
   read ( fi, y ) ; k := length ( y ) ; l := 1 ; //readln(fi,aa[i]);
   aa[i] := parse ( y, l ) ;
   if aa[i]>nmax then nmax:=aa[i];
   readln ( fi ) ;
  end;
 inc(nmax);
 generare;
 scor;
close(fi);
close(fo);
end.