II. RF KMF DokuWiki

Ez az oldal csak olvasható. Megtekintheted a forrását, de nem változtathatod meg. Ha úgy gondolod, hogy ez helytelen, kérdezd az Adminisztrátorokat!
====== Rekurzió ======

Rekurzió azt jelenti, hogy az alprogram meghívhatja saját magét mindaddig, amíg egy határértéket el nem ér.

===== Rekurzív összeg =====

<code pascal rekurziv_osszeg.pas>
function osszegzes (x : integer) : integer;
begin
  if x = 1 
  then osszegzes := 1
  else osszegzes := osszegzes(x - 1) + x
end;

</code>

===== Faktoriális számítás =====

<code pascal faktorialis.pas>
program faktor;
function faktorialis(n:integer):integer; {rekuzívan}
var fakt:integer;
begin
  if n > 1 then fakt:=n*faktorialis(n-1)
           else fakt:=1;
  faktorialis:=fakt;
end;
function fakt(n:integer):integer; {ciklussal}
var f,i:integer;
begin
  f:=1;
  for i:=1 to n do
    f:=i*f;
  fakt:=f;
end;
begin
  writeln('4! = ',faktorialis(4));
  writeln('4! = ',fakt(4));
  readln;
end.
</code>

===== Rekurzív átalakító kettes számrendszerbe =====

<code pascal atalakit.pas>
program atalakit;
procedure kettesbe(n:integer);
var egesz, maradek: integer;
begin
   maradek:= n mod 2;
   egesz:= n div 2;
   if egesz > 0 then kettesbe(egesz);
   write(maradek);
end;
begin
  write('10 a 2-be az ');
  kettesbe(10);
  readln;
end.
</code>


===== Hanoi tornyai =====

<code pascal hanoi_tornyai.pas>
program hanoi_tornyai;
procedure hanoi(n:integer;forras,cel,seged:string[5]);
begin
   if n > 0 then begin
      hanoi(n-1,forras,seged,cel);
      writeln(n,' ',forras:5,' -> ',cel:5);
      hanoi(n-1,seged,cel,forras);
   end;
end;
begin
  hanoi(3,'Rez','Arany','Ezust');
  readln;
end.
</code>

===== Huszárvándorlás-probléma =====

<code pascal lougras.pas>
program lougras;
uses crt;
 var i,j,n,nsqr:integer; q,qq:boolean;
     dx,dy:array[1..8]of integer;
     h:array[1..8,1..8]of integer;
 procedure lepes(i,x,y:integer;var q:boolean);
 var k,u,v:integer; q1:boolean;
 begin k:=0;
  repeat k:=k+1; q1:=false;
   u:=x+dx[k];v:=y+dy[k];
   if(1<=u)and(u<=n)and(1<=v)and(v<=n)and(h[u,v]=0)then begin
    h[u,v]:=i;
    if i<nsqr then begin lepes(i+1,u,v,q1);
      if not(q1) then h[u,v]:=0;end
    else q1:=true;
   end;
  until q1 or (k=8);
  q:=q1;
 end;
var c:char;
begin
  dx[1]:=2;  dx[2]:=1;  dx[3]:=-1; dx[4]:=-2;
  dx[5]:=-2; dx[6]:=-1; dx[7]:=1;  dx[8]:=2;
  dy[1]:=1;  dy[2]:=2;  dy[3]:=2;  dy[4]:=1;
  dy[5]:=-1; dy[6]:=-2; dy[7]:=-2; dy[8]:=-1;
  repeat
   write('Az n = ');readln(n);
   for i:=1 to n do
    for j:=1 to n do h[i,j]:=0;
   write('A kezd.poz.x=');readln(i);write('A kezd.poz.y=');readln(j);
   nsqr:=n*n;h[i,j]:=1; lepes(2,i,j,qq);
   if qq then
    for i:=1 to n do begin
     for j:=1 to n do write(h[i,j]:5);
     writeln;
    end
    else Writeln('Nincs lepes');
   writeln('Folyatja (kilepes ESC)?');
   c:=readkey;
  until (c=#27);

end.

</code>

===== Huszárvándorlás-probléma. Kimerítő keresés =====

<code pascal lougras_mind.pas>
program lougras_mind;

 var
  h: array[1..8,1..8]of integer;
  n,i,j,i0,j0,t:integer;
  x,y,x0,y0: integer;
  dx,dy: array[1..8]of integer;

procedure kereskovlepes(i,x,y: integer);
var
u,v,k:integer;
 begin
 for k:=1 to 8 do
  begin
    u:=x+dx[k]; v:=y+dy[k];
    if (1<=u) and (u<=n) and (1<=v) and (v<=n) and (h[u,v]=0)
     then
     begin
      h[u,v]:=i;      {bejegyzes}
      if (i<n*n) then
        kereskovlepes(i+1,u,v)
      else
       begin  {kiiratas}
         t:=t+1;
         for i0:=1 to n  do
           begin
            for  j0:=1 to n do
             write(h[i0,j0]:3);
            writeln;
           end;
         writeln(t,'===============');{uj sor a tablak kozott}
       end;
       h[u,v]:=0; {torles}
     end;
    end;
 end;



BEGIN

x0:=1; y0:=1; n:=5; t:=0;
 for i:=1 to n  do
  for  j:=1 to n do
   h[i,j]:=0;
dx[1]:= 2; dy[1]:= 1;
dx[2]:= 1; dy[2]:= 2;
dx[3]:=-1; dy[3]:= 2;
dx[4]:=-2; dy[4]:= 1;
dx[5]:=-2; dy[5]:=-1;
dx[6]:=-1; dy[6]:=-2;
dx[7]:= 1; dy[7]:=-2;
dx[8]:= 2; dy[8]:=-1;


h[x0,y0]:=1;

kereskovlepes(2,x0,y0);
 writeln;
 readln;


END.
</code>

===== Nyolckirálynő-probléma =====

<code pascal nyolc_vezer.pas>
program vezerek;
var i:integer; qq:boolean;
    x:array[1..8]of integer;
    a:array[1..8]of boolean;
    b:array[2..16]of boolean;
    c:array[-7..7]of boolean;

procedure elhelyez(i:integer;var q:boolean);
var j:integer;
begin j:=0;
  repeat j:=j+1; q:=false;
    if (a[j])and(b[i+j])and(c[i-j]) then begin
      x[i]:=j;
      a[j]:=false;b[i+j]:=false;c[i-j]:=false;
      if i<8 then begin
         elhelyez(i+1,q);
         if not q then begin
            a[j]:=true;b[i+j]:=true;c[i-j]:=true;
         end;
      end
      else q:=true;
    end;
  until q or (j=8);
end;
begin
  for i:=1 to 8 do a[i]:=true;
  for i:=2 to 16 do b[i]:=true;
  for i:=-7 to 7 do c[i]:=true;
  elhelyez(1,qq);
  for i:=1 to 8 do write(x[i]:4);
  readln;
end.
</code>

===== Nyolckirálynő-probléma. Kimerítő keresés =====

<code pascal nyolc_vezer_mind.pas>
program minden_vezer;
var i:integer;
    x:array[1..8]of integer;
    a:array[1..8]of boolean;
    b:array[2..16]of boolean;
    c:array[-7..7]of boolean;
procedure elhelyez(i:integer);
var j,k:integer;
begin
  for j:=1 to 8 do begin
    if (a[j])and(b[i+j])and(c[i-j]) then begin
      x[i]:=j;
      a[j]:=false;b[i+j]:=false;c[i-j]:=false;
      if i<8 then elhelyez(i+1)
             else
               for k:=1 to 8 do
                 if k<8 then write(x[k]:4)else writeln(x[k]:4);
      a[j]:=true;b[i+j]:=true;c[i-j]:=true;
    end;
  end;
end;
begin
  for i:=1 to 8 do a[i]:=true;
  for i:=2 to 16 do b[i]:=true;
  for i:=-7 to 7 do c[i]:=true;
  elhelyez(1);
  readln;
end.

</code>

===== Interaktív játékok =====
  * [[http://www.springfrog.com/games/chess/knights-tour/|Huszárvándorlás-probléma]]
  * [[http://www.hbmeyer.de/backtrack/achtdamen/eight.htm|Nyolckirálynő-probléma]]
  * [[http://www.web-games-online.com/towers-of-hanoi/index.php|Hanoi tornyai]]
II. RF KMF DokuWiki

Felhasználói eszközök

Eszközök a webhelyen

Eszközök az oldalon
