Cod sursa(job #480122)

Utilizator cont_de_testeCont Teste cont_de_teste Data 26 august 2010 14:50:37
Problema Sum Scor 85
Compilator fpc Status done
Runda Arhiva de probleme Marime 2.34 kb
type vec = string [255] ;

var N, j, i, k, l, y : longint ;
    v : array[1 .. 100000] of longint ;
    f, g : text ;
    x : vec ;


    procedure fisier;
        begin
            assign ( f,'sum.in' ) ; reset ( f ) ;
            assign ( g,'sum.out') ; rewrite ( g ) ;
        end;

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

    begin
            i := 1; y := 0;

            while ( i <= k ) do
                begin
                    y := y * 10 + ord ( x[i] ) - 48 ;
                    inc ( i ) ;
                end;

           parse := y ;
    end;

    procedure scrie ( k : qword ) ; inline ;
    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 100000 do
                v[i] := i ;

            i := 2 ;
            while ( i <= 100000 ) do
                begin
                    if ( v[i] = i ) then
                        begin
                            j := i ;
                            while j <= 100000 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 main ;
        begin
            for i := 1 to N do
                begin
                    readln ( f, x ) ; k := length ( x ) ;
                    y := parse ( x ) ;
                    scrie ( int64 ( v[y] ) * int64 ( y shl 1 ) ) ;
                end;
        end;

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