Помощь - Поиск - Пользователи - Календарь
Полная версия: Рекурсия
Форум «Всё о Паскале» > Pascal, Object Pascal > Задачи
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.

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

см. Ханойские башни.
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] пишется так только без пробела!
модератор
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.
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.
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.