Cod sursa(job #34463)

Utilizator vanila0406Ionescu Victor vanila0406 Data 20 martie 2007 19:48:54
Problema Fractii Scor 30
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.79 kb
program fractii;
var n:longint;
        v:array[1..1000] of longint;
        x:longint;
        f,g:text;




procedure iofile;
begin
        assign(f,'fractii.in');
        reset(f);
        assign(g,'fractii.out');
        rewrite(g);
        readln(f,n);
        close(f);
end;



procedure prel;
var i:longint;
        x,d,e,np,j:longint;
        s,p1,p2:qword;
begin
        s:=1;
        for i:=n downto 2 do
                begin
                        x:=i;
                        d:=2;
                        np:=0;
                        while x<>1 do
                                begin
                                        e:=0;
                                        while x mod d=0 do
                                                begin
                                                        inc(e);
                                                        x:=x div d;
                                                end;
                                        if e<>0 then
                                                begin
                                                        inc(np);
                                                        v[np]:=d;
                                                end;
                                        inc(d);
                                end;
                        p1:=i;
                        p2:=1;
                        for j:=1 to np do
                                begin
                                        p1:=p1*(v[j]-1);
                                        p2:=p2*v[j];
                                end;
                        s:=s+(p1 div p2)*2;
                end;
        writeln(g,s);
        close(g);
end;



begin
        iofile;
        prel;
end.