Cod sursa(job #89437)

Utilizator toni2007Pripoae Teodor Anton toni2007 Data 6 octombrie 2007 20:52:42
Problema Fractii Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.96 kb
var n,i:longint;
    r:real;
    s:string;
function euler(x:longint):longint;
var p,i,j,z:longint;
    b:boolean;
begin
     z:=0;
     p:=x;
     if x mod 2=0 then begin
        p:=p div 2;
        z:=z+1;
     end;
     if x=1 then p:=1
     else if x=2 then p:=1
     else if x=3 then p:=2
     else if x=4 then p:=2
     else if x=5 then p:=4
     else begin
          for i:=3 to trunc(x div 2)+1 do
              if x mod i=0 then begin
                 z:=z+1;
                 j:=1;
                 b:=true;
                 while (j<i-1) and (b=true) do begin
                       j:=j+1;
                       if i mod j=0 then b:=false;
                 end;
                 if b=true then p:=p*(i-1) div i;
              end;
          if z=0 then p:=p*(x-1) div x;
     end;
     euler:=p;
end;
begin
     readln(n);
     writeln('a) ',euler(n));
     r:=(euler(n)-1) div n;
     str(r,s);
     i:=pos(',',s);
     while