Версия для печати темы
Форум «Всё о Паскале» _ Задачи _ Рекурсия
Автор: Altair 6.04.2004 11:48
======= ВОЗВЕДЕНИЕ В СТЕПЕНЬ ===========
Вчера посмотрел на мои лабораторные по прологу и вспомнил про рекурсию.
Вот решил сделать на пасе. Посмотрите что получилось:
Код
{----------------------------------------------|
| процедура рекурсивного возведения |
| числа 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 7.04.2004 1:23
Код
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.
Программа про Ханойские башни.
см. http://forum.pascal.net.ru/index.php?showtopic=9254
Автор: Fire_Rage 7.04.2004 10:32
Код
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@ 7.04.2004 17:49
Чисто прикол:
заливка цветом 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 12.04.2004 10:43
Код
function factorial(n: byte):longint;
begin
if n=0 then factorial:=0
else factorial:=factorial(n+1)*n;
end;
Вот еще способ нахождения факториала!
Автор: trminator 12.04.2004 17:42
Цитата
else factorial:=factorial(n+1)*n;
Тогда уж так:
Цитата
else factorial:=factorial(n-1)*n;
Автор: volvo 21.12.2004 4:00
Рекурсивная функция перевода чисел из 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 21.12.2004 22:31
Рекурсивное нахождение чисел Фибоначчи:
Код
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.