Cod sursa(job #248314)

Utilizator rendorzegAndrei Pavel rendorzeg Data 25 ianuarie 2009 13:03:28
Problema Fractii Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.54 kb
type stiva=array [1..100] of longint;
var f,g:text;
    st:stiva;
    n,i,k,j:integer;
    as,ev:boolean;
function cmmdc(a,b:integer):integer;
var x:integer;
begin
if (b=0) and (a<>0) then x:=a
                    else if (a=0) and (b<>0) then x:=b
                                             else if a=b then x:=a
                                                         else if b<a then x:=cmmdc(a-b,b)
                                                                     else x:=cmmdc(a,b-a);
cmmdc:=x;
end;
procedure init(k:integer;var st:stiva);
begin
st[k]:=0;
end;
procedure succesor(k:integer; var st:stiva; var as:boolean);
BEGIN
if st[k]<n then begin
                st[k]:=st[k]+1;
                as:=true;
                end
           else
           as:=false;
end;
procedure valid(k:integer; st:stiva; var ev:boolean);
var i:integer;
begin
ev:=true;
if k>1 then if cmmdc(st[k-1],st[k])<>1 then ev:=false;
end;
function solutie(k:integer;st:stiva):boolean;
begin
solutie:=2=k;
end;
begin
assign(f,'fractii.in');
reset(f);
assign(g,'fractii.out');
rewrite(g);
read(f,n);
j:=0;
k:=1;
init(k,st);
while k>0 do begin
repeat
succesor(k,st,as);
if as then valid(k,st,ev);
until( as and ev) or (not as);
if as then if solutie (k,st) then       j:=j+1
                                        else begin
                                        k:=k+1;
                                        init(k,st);
                               end
      else k:=k-1;
      end;
write(g,j);
close(f);
close(g);
 end.