Cod sursa(job #172680)

Utilizator irene_mFMI Irina Iancu irene_m Data 6 aprilie 2008 17:24:38
Problema Fractii Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.02 kb
program fractii;
var x:array[1..2]of integer;
    n,nr:integer;
    f,g:text;

function continuare(k:integer):boolean;
var a,b:longint;
begin
 continuare:=true;
{ a:=x[1]; b:=x[2];
 while a<>b do
 begin
  if a>b then
   a:=a-b
  else
   b:=b-a;
 end;
 if a=1 then
  continuare:=true
 else
  continuare:=false;}
 if x[1]=x[2] then
  continuare:=false;
end;

procedure retsol;
var a,b:longint;
begin
 a:=x[1]; b:=x[2];
 while a<>b do
 begin
  if a>b then
   a:=a-b
  else
   b:=b-a;
 end;
 if a=1 then
  nr:=nr+1;
end;


procedure backtracking;
var k:integer;
begin
 k:=1;
 x[1]:=0; x[2]:=0;
 while k<>0 do
  if k=3 then
   begin
    retsol;
    k:=k-1;
   end
  else
   if x[k]<n then
    begin
     x[k]:=x[k]+1;
     if continuare(k) then
      k:=k+1;
    end
   else
    begin
     x[k]:=0;
     k:=k-1;
    end;
 end;

begin
assign(f,'fractii.in');assign(g,'fractii.out');
reset(f); rewrite(g);
readln(f,n);
nr:=1;
backtracking;
write(g,nr);
close(f); close(g);
end.