Программирование фракталов

ПРОГРАММИРОВАНИЕ ФРАКТАЛОВ 

1. Фрактал Серпинского. Вычисление с помощью метода рекурсии на языке PascalABC.

uses graphABC;
procedure rec(x,y, x2,y2, x3,y3, n:integer);
  var xa, ya, xb, yb, xc, yc:integer;

begin
if n >0 then begin
{рисуем треугольник}
line(x,y,x2,y2);
line(x3,y3,x2,y2);
line(x,y,x3,y3);
{вычисляем середины сторон}
xa:=(x+x2) div 2; ya:=(y+y2) div 2;
xb:=(x3+x2) div 2; yb:=(y3+y2) div 2;
xc:=(x+x3) div 2; yc:=(y+y3) div 2;
{и рекурсивно рисуем три меньших треугольника}
rec(x,y,xa, ya, xc, yc, n-1);
rec(x2,y2,xa, ya, xb, yb, n-1);
rec(x3,y3,xb, yb, xc, yc, n-1);
end;
end;
Begin
rec(100,300,200,120,300,300,7);
End.

____________________________________________________

Геометрический фрактал "Треугольник Серпинского" 

2. Пример программ 

ирования геометрического фрактала "Треугольник Серпинского" на языке Small Basic:

GraphicsWindow.BackgroundColor = "Black"
x = 100
y = 100

For i = 1 To 100000
  r = Math.GetRandomNumber(3)
  ux = 150
  uy = 30
  If (r = 1) then
    ux = 30
    uy = 1000
  EndIf

  If (r = 2) Then
    ux = 1000
    uy = 1000
  EndIf

  x = (x + ux) / 2
  y = (y + uy) / 2

  GraphicsWindow.SetPixel(x, y, "LightGreen")
  Program.Delay(2)
EndFor

____________________________________________________

3. "Ковер Серпинского" 

program Serp;

uses GraphABC;

var
  a,b,x,y: integer;
  N: integer;

procedure lrel (dx,dy: integer);
begin
  x:=x+dx; y:=y+dy; LineTo(x,y);
end;

procedure BB(k: integer); forward;
procedure CC(k: integer); forward;
procedure DD(k: integer); forward;

procedure AA(k: integer);
begin
 if k>0 then
 begin
   AA(k-1); lrel(a,b);
   BB(k-1); lrel(a,0);
   DD(k-1); lrel(a,-b);
   AA(k-1);
 end;
end;

procedure BB(k: integer);
begin
 if k>0 then
 begin
   BB(k-1); lrel(-a,b);
   CC(k-1); lrel(0,b);
   AA(k-1); lrel(a,b);
   BB(k-1);
 end;
end;

procedure CC(k: integer);
begin
 if k>0 then
 begin
   CC(k-1); lrel(-a,-b);
   DD(k-1); lrel(-a,0);
   BB(k-1); lrel(-a,b);
   CC(k-1);
 end;
end;

procedure DD(k: integer);
begin
 if k>0 then
 begin
   DD(k-1); lrel(a,-b);
   AA(k-1); lrel(0,-b);
   CC(k-1); lrel(-a,-b);
   DD(k-1);
 end;
end;

begin
  N:=6;
  a:=3;
  b:=a;
  x:=10;
  y:=10;
  SetWindowCaption('Ковер Серпинского');
  SetWindowSize(590,590);
  MoveTo(x,y);
  AA(N); lrel(a,b);ирBB(N);о lrel(-a,b);
  CC(N); lrel(-a,-b);
  DD(N); lrel(a,-b);
end.

___________________________________________________________________

4. Программирование фрактала "Поле из одуванчиков" на языке PascalABC 

uses Utils,GraphABC;
const   n=255;
  max=10;
var
  z,z1,c: complex;
  i,ix,iy: integer;
// z=z^2+c
begin
  cls;
  SetWindowCaption('Фракталы: поле из одуванчиков');
  SetWindowSize(400,300);
  c:=(0.6,0.9); {комплексное число}
  for ix:=0 to WindowWidth-1 do
  for iy:=0 to WindowHeight-1 do
  begin
    z:=0.015*(ix-200,iy-140);
    for i:=1 to n do

    begin

                     z1:=0.5*z*z+c;

                                          if abs(z1)>max then break;

      z:=z1;

    end;

                                                                               if i>=n then SetPixel(ix,iy,clRed)
                                                                                  else SetPixel(ix,iy,RGB(255,255-i,255-i));
                                                                               end;
                                                                         writeln('Время расчета = ',Milliseconds/1000,' с');
                                                                      end.

5. Пример программы построения фрактала "Дерево"

Алгоритм построения "Веточки" (М. Павлова, Н. Паньгина. Рекурсивные алгоритмы и их построение.Учебное пособие. -СПб.: Издатедьство ЦПО "Информатизация образования", 2001. - 19 с.). Первый отрезок рисуется под произвольным углом к оси Ох, из конца  данного отрезка рисуется пара отрезков, направленных в противоположные стороны от направления парвого отрезка под одинаковым величиной 30 градусов. Далее рисунок повторяется с каждым из вновь построенных отрезков с умнгтшением длины отрезклв примерно в полтора раза.

Вложенность такого рекурсивного рисунка. еае видно, не менее семи.
Рекурсивная функция имеет 4 парамеира: координаты начала отрезка, его длину и угол, под ноторым рисуется лванный отрезок к ос Ох.

Алгоритм построения состоит из следующих шагов:
длина и угол наклона).
2. Нарисовать отрезок. 
3. Вызвать рекурсивную процедуру,   рисующую левую ветку, с новыми параметрами (за координаты начала отрезка взять только что вычисленные координаты конца отрезка, за длину - длину, уменьшенную в полтора раза, за угол, уменьшенный на 30 градусов.
4. Вызвать рекурсивную процедуру, рисующую правую ветку (параметры такие же, как в пун кте  3, за исключением угла - новый угол увеличивается на 30 градусов относительно первонач ального угла).
5. Выход из процедуры осуществляется, когда длина ветки становится очень малой (около 2 пикселей).

В программе имеется лишь одно обращение к процедуре со следующими параметрами: координаты начала самого первого отрезка, первоначаная длина отрезка, первоначальная длина отрезка и произвольный угол наклона.

Программа "Ветка дерева" на языке PascalABC
uses GraphABC;
const
   radian=Pi/180; deltaangle=30*radian;
Procedure Ris(x,y: integer; len, angle: real);
   var 
       color, xnew, ynew:integer;
Begin 
    if len<1 then exit; {Выход из рекурсии при длине ветки меньше 1 пиксела}
if len<15 then color:=14 else color:=15;{Листья - жёлтым цветом, ствол белым}
xnew:=x+round(Len*cos(angle)); {координаты конца ветки}
ynew:=y+ round(len*sin(angle));
SetColor(color); Line(x,y,xрnew,ynew); {Рисуем ветку}
Ris(xnew, ynew, len*0.65, angle-deltaangle);{Рисуем левую подветку}
Ris(xnew, ynew, len*0.65, angle+deltaangle);{Рисуем правую подветку}
end;
Be gin
  Ris(100,400,160,-40*radian);
End.

6.  "Снежинка"

Пример программы

//Снежинка
uses graphABC;
const
 step=Pi*0.2;
Procedure DrawStar(x,y,size:integer); {x,y - координаты центра и size - радиус снежинки}
  var i,j,newsize, xnew,ynew:integer;
Begin
  if size<1 then PutPixel(x,y,15) else
    for i:=0 to 9 do {первый цикл - по количеству направляющих снежинки}
      begin
       newsize:=size;
       for j:=1 to 8 do {второй цикл -рисование 8-ми подуровней снежинки}
        begin
         xnew:=x+round(newsize*cos(i*step));
         ynew:=y+round(newsize*sin(i*step));
         DrawStar(xnew,ynew,newsize div 5);
         newsize:=newsize*2 div 3;
       end;
     end;
  End;{конец процедуры}
Begin {Главная}
  DrawStar(320,240,160);
End.

7.  Множество Мандельброта (Википедия) 

Помимо геометрических построений для получения фрактала можно применять алгебраические выражения (формулы). Например, озеро Мандельброта определяется так:   
                  Zn+1 = Zn×Zn+С , где Z – комплексное число. 

В данном случае применен метод итерации, т.е. многократного расчета функции 
Zn+1 = f(Zn).

Визуально, внутри множества Манделедияьброта можно выделить бесконечное количество элементарных фигур, причём самая большая в центре представляет собой кардиоиду. Также есть набор овалов, касающихся кардиоиды, размер которых постепенно уменьшается, стремясь к нулю.
Каждый из этих овалов имеет свой набор меньших овалов, диаметр которых также стремится к нулю и т. д. Этот процесс продолжается бесконечно, образуя фрактал. Также важно, что эти процессы ветвления фигур не исчерпывают полностью множество Мандельброта: если рассмотреть с увеличением дополнительные «ветки», то в них можно увидеть свои кардиоиды и круги, не связанные с главной фигурой. Самая большая фигура (видимая при рассматривании основного множества) из них находится в области от −1,78 до −1,75 на отрицательной оси действительных значений.

Программа на языке Small Basic 

В основу построения множества Мандельброта были взяты итеративные последовательности вида:

Параметры p,q изменялись с помощью вложенных циклов For.

//Множество Мандельброта. (Автор программы Чернышёв Александр)

GraphicsWindow.Width=400  {ширина окна}

GraphicsWindow.Height=400 {высота окна}

For p=-2 To 2 Step .01  {изменение параметра p}

  for q=-2 To 2 Step .01   {изменение параметра q} 

    xn1=0

    yn1=0

    m=0

    c=0   {начальное значение переменной цикла c}

    while m<2 and c<100 

      xn=xn1*xn1-yn1*yn1+p

      yn=2*xn1*yn1+q

      xn1=xn

      yn1=yn

      m=Math.SquareRoot(xn*xn+yn*yn)  

      c=c+1

  EndWhile

{выбор цвета точки на плоскости в зависимости от переменной цикла c}

If c=100 Then

  color="black"

EndIf

If c<100 and c>90 Then

  color="darkred"

EndIf

If c<91 and c>80 Then

  color="red"

EndIf

If c<81 and c>70 Then

  color="red"

EndIf

If c<71 and c>60 Then

  color="orangered"

  EndIf

If c<61 and c>50 Then

  color="orange"

EndIf

If c<51 and c>40 Then

  color="yellow"

EndIf

If c<41 and c>30 Then

  color="springgreen"

EndIf

If c<31 and c>20 Then

  color="green"

EndIf

If c<21 and c>10 Then

  color="lightseagreen"

EndIf

If c<11 Then

  color="blue"

  EndIf

GraphicsWindow.SetPixel(p*100+200,q*100+200,color)

EndFor

EndFor