Cod sursa(job #155662)

Utilizator luigiPacala luigi Data 12 martie 2008 02:11:05
Problema Fractii Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.67 kb
var f:text;
    n,j,i,s,a,b,rest:longint;
    ok:boolean;
    begin
assign(f, 'fractii.in');
reset(f);
read(f,n);
s:=n*n;
close(f);
for i:=2 to n do
begin
   if i mod 2 =0 then
       begin
             a:=i div 2;
             ok:=false;
              if a<>1 then
               begin
                while (ok=false) and (a<>1) do
                 begin
                  if a mod 2 <>0 then
                   if a<>1 then
                    ok:=true;
                    if ok=false then
                    a:=a div 2;
                 end;
               end;
           if a<>1 then
            begin
             s:=s-(n div 2);
              if a>=3 then
             s:=s-(n div a)+(n div a)div 2
                  else
             s:=s-(n div a)
            end
           else
             s:=s-(n div 2);
         end;
   if i mod 2<>0 then
     begin
        if i mod 3=0 then
         begin
           a:=i div 3;
           ok:=false;
           if a<>1 then
           begin
           while (ok=false) and (a<>1) do
              begin
               if a mod 3 <>0 then
                if a<>1 then
                 ok:=true;
                 if ok=false then
                 a:=a div 3;
              end;
           end;
           if a<>1 then
            begin
             s:=s-(n div 3);
             if a>=3 then
             s:=s-(n div a)+(n div a)div 2

               else
             s:=s-(n div a);
            end
             else
            s:=s-(n div 3);
         end
          else
           s:=s-(n div i);
     end;
end;
assign(f, 'fractii.out');
rewrite(f);
write(f,s);
close(f);
end.