Рекурсия -> АЛДАН - IV

Рекурсия
Рекурсия - это вызов функции (процедуры) из самой себя. Я воспринимаю рекурсию как трюк, который позволяет программисту облегчить себе жизнь. Как у каждого трюка у рекурсии есть свои достоинства и недостатки. К достоинствам относится способность создавать простой код. К недостаткам: медленность работы.

Несмотря на все недостатки, присущие рекурсии, она мне нравится. Как говорится любят ни за что, не любят за все.

Где хоть как то объясняется слово рекурсия в качестве примера приводится программа вычисления факториала. Если захотите, сами найдете.

А первая программа будет печатать полный текст стихотворения "У попа была собака".

Вторая программа: то, что я условно назвал квадраты. Но если угодно это могут быть ромбы, треугольники и другие фигуры. Как захотите, так и сделаете.

Подсчет частей, на которые развалится доска. При помощи рекурсии решается просто. Искать ее здесь.


Квадраты -> АЛДАН - IV

Квадраты

Строится прямоугольник. Каждая его сторона делится в заданном отношении, задавая таким образом новую вершину. Затем на вновь полученных вершинах строится новый четырехугольник.

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.
Вот и все.


У попа была собака -> АЛДАН - IV

У попа была собака

Для тех, кто не знает, привожу полный текст стихотворения:
     У попа была собака
     Он ее любил
     Она съела кусок мяса
     Он ее убил и на камне написал:
А дальше по кругу то же самое.

Конечно его можно было бы проще напечатать с помощью цикла но это не интересно. Рекурсия больше отвечает духу стихотворения. Конечный цикл рано или поздно закончится, т.е. не не выполнит задание до конца, а бесконечный подразумевает бессмысленность труда автора (попа), поскольку какой смысл трудиться, точно зная, что стихотворение никогда не будет написано до конца? С рекурсией дело хитрее. Вызывая в который раз саму себя, функция считает, что скоро будет конец, что в ближайшем вызове дело закончится полным успехом. А чтобы во время печати не пришлось ждать слишком долго, пусть программа продолжается до тех пор, пока не будет нажата какая-нибудь клавиша.

   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.


Разбиение Доски -> АЛДАН - IV

Разбиение доски

Сама проблема стоит следующим образом: Дана клетчатая доска прямоугольной формы. Некоторые клетки на ней выколоты. Требуется определить на сколько частей распадется доска.

Суть алгоритма проста: сама доска (массив) заполняется единицами, выколотые клетки нулями. затем начинается просмотр всех клеток подряд. Примерно следующим образом:

  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.

Архив программы находится здесь: RAR-архив.