Рекурсия, интересные рекурсивные решения Опции

[Altair]

======= ВОЗВЕДЕНИЕ В СТЕПЕНЬ ===========
Вчера посмотрел на мои лабораторные по прологу и вспомнил про рекурсию.
Вот решил сделать на пасе. Посмотрите что получилось:

Код

{----------------------------------------------|
| процедура рекурсивного возведения |
| числа p в степень n, результат           |
|  - число r                                           |
|----------------------------------------------}
Procedure S(Var p,n,r : Integer);
Begin
IF r=0 Then r:=1;
IF n=0 Then Exit;
r:=r*p;
Dec(n);
S(p,n,r)
End;

Var
a,b,c:Integer;
Begin
ReadLn(a,b);
S(a,b,c);
WriteLn(c);
End.

Процедура возводит число p в n -ую степень.


--------------
Выкладывайте сюда свои интересные рекурсивные решения!

[Catty]

Код

Program Hanoj;
Const k = 3;
Var a, b, c : Char;
Procedure Disk(n : Integer; a, b, c: Char);
Begin
  If n>0 Then Begin
    Disk(n-1, a, c, b);
    WriteLn('Диск ',n, ' c ', a,'->', b);
    Disk(n-1, c, b, a);
  End;
End;

BEGIN
  a := 'A'; b := 'B'; c := 'C';
  Disk(k,a,b,c);
  ReadLn;
END.

Программа про Ханойские башни.

см. Ханойские башни.

Сообщение отредактировано: volvo - 14.05.2009 15:00

[Fire_Rage]

Код

procedure nod(var a,b:integer):integer;
var i:integer;
begin
  if a=b then i=a
            else if a>b then i=nod(a mod b,b )
                            else i=nod(a,b mod a);
  nod=i;
end;

НОД 2-х чисел.


тег [ code] пишется так только без пробела!
модератор

Сообщение отредактировано: Oleg_Z - 7.04.2004 6:48

[P@sh@]

Чисто прикол:
заливка цветом fillcolor области, ограниченной цветом bordercolor:

Код

procedure Fill(x,y,fillcolor,bordercolor: integer);
begin
 if (getpixel(x,y)=bordercolor)
 or (getpixel(x,y)=fillcolor) then exit;
 putpixel(x,y,fillcolor);
 Fill(x,y-1,fillcolor,bordercolor);
 Fill(x,y+1,fillcolor,bordercolor);
 Fill(x-1,y,fillcolor,bordercolor);
 Fill(x+1,y,fillcolor,bordercolor);
end;

применять не рекомендую, постоянно будет stack overflow

[Гость_fobos73]

Код

function factorial(n: byte):longint;
begin
      if n=0 then factorial:=0
         else factorial:=factorial(n+1)*n;
end;

Вот еще способ нахождения факториала!

[trminator]

else factorial:=factorial(n+1)*n;

Тогда уж так:

else factorial:=factorial(n-1)*n;

[volvo]

Рекурсивная функция перевода чисел из 10-ной с/с в любую другую...

Код

function fromdec(n, radix: longint):string;
 const
   digit: string[16]='0123456789ABCDEF';
 begin
   if n = 0 then fromdec := ''
   else
     fromdec := fromdec(n div radix, radix) + digit[(n mod radix)+1]
 end;

begin
 writeln(fromdec(256, 8)); {256(10) переводим в 8-ю с/с }
end.

Сообщение отредактировано: volvo - 21.12.2004 0:01

[mithquessir]

Рекурсивное нахождение чисел Фибоначчи:

Код

function fib(n:integer):longint;
 begin
   case n of
     0: fib := 0;
     1,2:fib := 1
     else
       fib := fib(n-1) + fib(n-2)
   end;
 end;

begin
 WriteLn(fib(33));
end.

Рекурсивный перевод чисел в двоичную систему счисления:

Код

procedure bin(n:longint);
 begin
   if n > 1 then
     bin(n div 2);
   Write(n mod 2);
 end;

begin
 bin(256);
end.

Быстрая сортировка Хоара:

Код

const
 n = 5;
 a:array[1..n] of integer= (2,5,2,1,-4);
var
 i:integer;  
procedure QSort(m,l:word);
 var
   x,i,j:integer;
   w:word;
 begin
   i := m;
   j := l;
   x := a[(m+l) div 2];
   repeat
     while a[i] < x do
     inc(i);
     while a[j] > x do
     dec(j);
     if i <= j then
     begin
       w := a[i];
       a[i] := a[j];
       a[j] := w;
       inc(i);
       dec(j);
     end;
   until i > j;
   if m < j then QSort(m,j);
   if i < l then QSort(i,l);
end;

begin
 QSort(1,n);
 for i := 1 to n do
   Write(a[i]:2);
end.