IPB
ЛогинПароль:

> Прочтите прежде чем задавать вопрос!

1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code], либо быть опубликованы на нашем PasteBin в режиме вечного хранения.
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!

 
 Ответить  Открыть новую тему 
> Рекурсия, интересные рекурсивные решения
сообщение
Сообщение #1


Ищущий истину
******

Группа: Пользователи
Сообщений: 4 825
Пол: Мужской
Реальное имя: Олег

Репутация: -  45  +


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

{----------------------------------------------|
| процедура рекурсивного возведения |
| числа 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 -ую степень.


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


--------------------
Помогая друг другу, мы справимся с любыми трудностями!
"Не опускать крылья!" (С)
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #2


Бывалый
***

Группа: Пользователи
Сообщений: 239
Пол: Женский
Реальное имя: Юлия

Репутация: -  3  +


Код
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 -


--------------------
For every evil under the sun
There is a remedy or there is none
If there is one - try to find it
If there is none - never mind it!
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #3


Новичок
*

Группа: Пользователи
Сообщений: 26

Репутация: -  0  +


Код

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 -


--------------------
QUI NON PROFICIT, DEFICIT(Кто не идёт вперёд, идёт назад)
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #4


Бывалый
***

Группа: Пользователи
Сообщений: 180
Пол: Мужской

Репутация: -  2  +


Чисто прикол:
заливка цветом 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
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #5


Гость






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

Вот еще способ нахождения факториала!
 К началу страницы 
+ Ответить 
сообщение
Сообщение #6


Четыре квадратика
****

Группа: Пользователи
Сообщений: 579
Пол: Мужской

Репутация: -  4  +


Цитата
else factorial:=factorial(n+1)*n;

Тогда уж так:
Цитата
else factorial:=factorial(n-1)*n;


--------------------
Закон добровольного труда Зимерги:
Люди всегда согласны сделать работу, когда необходимость в этом уже отпала
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #7


Гость






Рекурсивная функция перевода чисел из 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 -
 К началу страницы 
+ Ответить 
сообщение
Сообщение #8


Гость






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

Код

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.
 К началу страницы 
+ Ответить 

 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 





- Текстовая версия 1.10.2020 21:13
500Gb HDD, 6Gb RAM, 2 Cores, 7 EUR в месяц — такие хостинги правда бывают
Связь с администрацией: bu_gen в домене octagram.name