Cod sursa(job #479799)

Utilizator cont_de_testeCont Teste cont_de_teste Data 25 august 2010 13:17:24
Problema Sum Scor 85
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.79 kb
type vec = string [255] ;
var n,j,i,k,l,y:longint;
    sum:int64;
    v:array[1..100005] of longint;
    f,g:text;
    x : vec ;


 procedure fisier;
 begin
  assign(f,'sum.in');
  assign(g,'sum.out');
  reset(f);
  rewrite(g);
 end;
   function parse ( var x : vec ) : longint ;
    var i , y : longint;

    begin
            i := 1; 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
                            inc ( i ) ;
                            break;
                        end;

                    inc ( i ) ;

                end;

           parse := y;
  end;
  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(g,st);
end;
 procedure ciur;
  begin
  for i:=1 to 100005 do
   v[i]:=i;

  i := 2 ;
  while ( i <= 100005 ) do
  begin
   if ( v[i] = i ) then
   begin
    j:=i;
     while j<=100005 do
      begin
       v[j]:=v[j] div i * ( i - 1 );
       j:=j+i;
      end;
   end;
  if ( i = 2 ) then inc ( i, 1 )
    else inc ( i, 2 ) ;
 end;
  end;

 procedure citire;
 begin
   readln(f,n);
 end;




 procedure scriere;
 begin
  scrie ( int64(v[y]) * int64 (y shl 1) ) ;
 end;

 procedure main;
 begin
  for i:=1 to n do
   begin

    read ( f, x ) ; k := length ( x ) ;
    y := parse ( x ) ;

    scriere;
    readln ( f ) ;
   end;
 end;

 begin
  fisier;
  ciur;
  citire;
  main;
  close(f);
  close(g);
 end.