Cod sursa(job #13608)

Utilizator mariuscris90giuroiu marius mariuscris90 Data 7 februarie 2007 11:11:08
Problema Fractii Scor 30
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.87 kb
{$n+}
program fractiii;
type vec=array[1..10] of longint;
     vector=array[1..4000000] of record
                           x:boolean;
                           y:vec;
                           l:byte;end;
var a:vector;
    n,z,i,j,s1,p,p1:longint;
    t:boolean;
    s:extended;
    f,g:text;
begin
assign(f,'fractii.in');assign(g,'fractii.out');reset(f);rewrite(g);
read(f,n);
for i:=2 to n do begin
z:=i;
while z<n do begin
z:=z+i;
a[z].x:=true;t:=true;
for j:=1 to a[z].l do
if i mod a[z].y[j]=0 then
begin t:=false;break;end;
if t then begin
a[z].l:=a[z].l+1;a[z].y[a[z].l]:=i;end;
end;
end;
for i:=2 to n do begin
if a[i].x=false then s:=s+(i-1)*2
                else begin
p:=1;s1:=0;p1:=i;
for j:=1 to a[i].l do begin
p:=p*a[i].y[j];p1:=p1*(a[i].y[j]-1);end;
s1:=p1 div p;s:=s+s1*2;end;end;
s:=s+1;write(g,s:0:0,' ');
close(f);close(g);end.