Где хоть как то объясняется слово рекурсия в качестве примера
приводится программа вычисления факториала.
А первая программа будет печатать полный текст стихотворения"У
попа была собака".
Для тех, кто не знает, вот полный текст стихотворения:
У попа была собака
Он ее любил
Она съела кусок мяса
Он ее убил и на камне написал:
А дальше по кругу то же самое.
Конечно его можно было бы проще напечатать с помощью цикла но это не интересно. Рекурсия больше отвечает духу стихотворения. Конечный цикл рано или поздно закончится, т.е. не не выполнит задание до конца, а бесконечный подразумевает бессмысленность труда автора (попа), поскольку какой смысл трудиться, точно зная, что стихотворение никогда не будет написано до конца? С рекурсией дело хитрее. Вызывая в который раз саму себя, функция считает, что скоро будет конец, что в ближайшем вызове дело закончится полным успехом. А чтобы во время печати не пришлось ждать слишком долго, пусть программа продолжается до тех пор, пока не будет нажата какая-нибудь клавиша.
program pop;
uses crt;
procedure absaz(c:word);{ Процедура,
печатающая один абзац }
{ В качестве параметра цвет абзаца }
begin
textcolor(c);
writeln(' У попа была собака');
writeln(' Он ее любил');
writeln(' Она съела кусок мяса');
writeln(' Он ее убил');
writeln(' И на камне написал:');
delay(500);{ Задержка перед выводом
следующего абзаца }
if not keypressed then absaz((c+1)mod 15+1);
{ Продолжать, пока не нажата клавиша }
end;
begin
clrscr;
absaz(1);
readkey;
end.
Вторая программа: условно можно назвать квадратами.
Но если угодно это могут быть ромбы, треугольники и другие фигуры. Как
захотите, так и сделаете.
Строится прямоугольник. Каждая его сторона делится в заданном отношении, задавая таким образом новую вершину. Затем на вновь полученных вершинах строится новый четырехугольник.
program kvadr;
uses crt,graph;
const n=10;
var l:word;
procedure new(x1,y1,x2,y2:integer;var xl,yl:integer);
{ Вычисление новой координаты вершины }
begin
xl:=(x1+(n-1)*x2) div n;
yl:=(y1+(n-1)*y2) div n;
end;
{ Процедура построения четырехугольника }
procedure postroit(x1,y1,x2,y2,x3,y3,x4,y4:integer);
var l1,k1,l2,k2,l3,k3,l4,k4:integer;
label qv;
begin
setcolor(l);
line(x1,y1,x2,y2);
line(x2,y2,x3,y3);
line(x3,y3,x4,y4);
line(x4,y4,x1,y1);
if abs(x2-x1)<0.001 then goto qv; { Проверка окончания
построения }
new(x1,y1,x2,y2,l1,k1);
new(x2,y2,x3,y3,l2,k2);
new(x3,y3,x4,y4,l3,k3);
new(x4,y4,x1,y1,l4,k4);
delay(70);
postroit(l1,k1,l2,k2,l3,k3,l4,k4);
qv:
end;
var k,dr,md:integer;
x1,x2,x3,x4,y1,y2,y3,y4:integer;
begin
l:=10;
x1:=120;y1:=40;
x2:=520;y2:=40;
x3:=520;y3:=440;
x4:=120;y4:=440;
dr:=9;md:=2;
initgraph(dr,md,'');
setbkcolor(1);
postroit(x1,y1,x2,y2,x3,y3,x4,y4);
readln;
closegraph;
end.
Подсчет частей, на которые развалится доска. При помощи рекурсии
решается просто.
Сама проблема стоит следующим образом: Дана клетчатая доска прямоугольной формы. Некоторые клетки на ней выколоты. Требуется определить на сколько частей распадется доска.
Суть алгоритма проста: сама доска (массив) заполняется единицами, выколотые клетки нулями. затем начинается просмотр всех клеток подряд. Примерно следующим образом:
for i:=1 to m do for j:=1 to n do
begin
if doska.d[i,j]=1 then begin s:=s+1;
proverka(i,j);end;
end;Если находится клетка содержание которой равно единице, то запускается процедура proverka(i,j)
главная цель которой - выявить кусок доски которому принадлежит клетка, заполнить, его значением
s>1 (для каждого куска свое). Все это происходит по рекурсии следующим образом:procedure traschet.proverka(a,b:byte); begin doska.d[a,b]:=s; if doska.d[a-1,b]=1 then proverka(a-1,b); if doska.d[a+1,b]=1 then proverka(a+1,b); if doska.d[a,b-1]=1 then proverka(a,b-1); if doska.d[a,b+1]=1 then proverka(a,b+1); end;Для красоты сделал некоторое подобие интерфейса (чтоб было проще доску на части раскалывать).
Работа программы строится на трех объектах: доски - tdoska, расчета - traschet и курсора - tkyrsor.