Cod sursa(job #479810)

Utilizator cont_de_testeCont Teste cont_de_teste Data 25 august 2010 13:37:59
Problema Sum Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 2.85 kb
type vec = string [255] ;

var vi : array[1..66] of word = ( 2, 3, 5, 7, 11, 13, 17, 19, 23, 29, 31, 37, 41, 43, 47, 53, 59, 61, 67, 71, 73, 79, 83, 89, 97,
101, 103, 107, 109, 113, 127, 131, 137, 139, 149, 151, 157, 163, 167, 173, 179, 181, 191, 193, 197,
199, 211, 223, 227, 229, 233, 239, 241, 251, 257, 263, 269, 271, 277, 281, 283, 293, 307, 311, 313, 317 ) ;
    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 ;
    var i , y : longint;

    begin
            i := 1; y := 0;

            while ( true ) 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 100000 do
                v[i] := i ;

            i := 1 ;
            while ( i <= 66 ) do
                begin
                    //if ( v[i] = i ) then
                       // begin
                            j := vi[i] ;
                            while j <= 100000 do
                                begin
                                    v[j] := v[j] div vi[i] * ( vi[i] - 1 ) ;
                                    j := j + vi[i] ;
                                end;
                        //end;
                    inc ( i ) ;
                end;
        end;

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


    procedure main ;
        begin
            for i := 1 to N do
                begin
                    read ( f, x ) ;
                    y := parse ( x ) ;
                    scrie ( int64 ( v[y] ) * ( y shl 1 ) ) ;
                    readln ( f ) ;
                end;
        end;

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