Меню сайта

Наш опрос
Оцените мой сайт Отлично Хорошо Неплохо Плохо Ужасно Результаты \| Архив опросов Всего ответов: 127

Статистика
Онлайн всего: 1 Гостей: 1 Пользователей: 0

Фракталы - Pascal ABC

Фрактал - геометрическая фигура, обладающая свойством самоподобия, то есть составленная из нескольких частей, каждая из которых подобна всей фигуре целиком. В математике под фракталами понимают множества точек в евклидовом пространстве, имеющие дробную метрическую размерность (в смысле Минковского или Хаусдорфа), либо метрическую размерность, отличную от топологической.

1. Кривая Госпера

Program Gosper_Curve;
Uses CRT, GraphABC;
Procedure Draw(x, y, l, u : Real; t, q : Integer);
Procedure Draw2(Var x, y: Real; l, u : Real; t, q : Integer);
Begin
     Draw(x, y, l, u, t, q);
       x := x + l*cos(u);
       y := y - l*sin(u)
End;
Begin
     If t > 0 Then
     Begin
          If q = 1 Then
          Begin
               x := x + l*cos(u);
                     y := y - l*sin(u);
                     u := u + pi
          End;
          u := u - 2*pi/19;
              l := l/sqrt(7);
              Draw2(x, y, l, u, t-1, 0);
              Draw2(x, y, l, u+pi/3, t-1, 1);
              Draw2(x, y, l, u+pi, t-1, 1);
          Draw2(x, y, l, u+2*pi/3, t-1, 0);
          Draw2(x, y, l, u, t-1, 0);
          Draw2(x, y, l, u, t-1, 0);
          Draw2(x, y, l, u-pi/3, t-1, 1)
     End
     Else
         Line(Round(x), Round(y), Round(x + cos(u)*l), Round(y -sin(u)*l))
     End;
Begin
     SetWindowCaption('Фракталы: Кривая Госпера');
     SetWindowSize(650,500);
     ClearWindow;
     Draw(100, 355, 400, 0, 4, 0);
     Repeat Until KeyPressed
End.

2. Дерево Пифагора

Program Pifagor;

uses CRT, GraphABC;
Procedure Rect(x1, y1, l: Integer; a1: Real);
Begin
     MoveTo(x1, y1);
       LineTo(x1 + Round(l * cos(a1)), y1 - Round(l * sin(a1)));
       LineTo(x1 + Round(l * sqrt(2) * cos(a1 + pi/4)),
         y1 - Round(l * sqrt(2) * sin(a1 + pi/4)));
       LineTo(x1 + Round(l * cos(a1 + pi/2)), y1 - Round(l * sin(a1 + pi/2)));
       LineTo(x1, y1)
End;

Procedure Draw(x, y, l, a: Real);
Begin
     If l > 4 Then
     Begin
              Rect(Round(x), Round(y), Round(l), a);
              Draw(x - l*sin(a), y - l * cos(a), l / sqrt(2), a + pi / 4);
              Draw(
                     x - l * sin(a) + l / sqrt(2) * cos(a + pi/4),
                     y - l * cos(a) - l / sqrt(2) * sin(a + pi/4),
                     l / sqrt(2),
               a - pi/4)
     End
End;
Begin
     SetWindowCaption('Фракталы: Дерево Пифагора');
     SetWindowSize(730,500);
     ClearWindow;
     Draw(280, 460, 100, 0);
       Repeat Until KeyPressed
End.

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

Program Serpinskiy;

Uses CRT, GraphABC;
Const Z = 6; {Глубина фрактала}
Var
   x1, y1, x2, y2, x3, y3: Real;
Procedure Serp(x1, y1, x2, y2: Real; n: Integer);
Var
   x1n, y1n, x2n, y2n: Real;
Begin
     If n > 0 Then
     Begin
          x1n := 2*x1/3 + x2 / 3;
          x2n := x1/3 + 2*x2 / 3;
          y1n := 2*y1/3 + y2 / 3;
          y2n := y1/3+2*y2 / 3;
          Rectangle(Round(x1n), Round(y1n), Round(x2n), Round(y2n));
          Serp(x1, y1, x1n, y1n, n-1);
          Serp(x1n, y1, x2n, y1n, n-1);
          Serp(x2n, y1, x2, y1n, n-1);
          Serp(x1, y1n, x1n, y2n, n-1);
          Serp(x2n, y1n, x2, y2n, n-1);
          Serp(x1, y2n, x1n, y2, n-1);
          Serp(x1n, y2n, x2n, y2, n-1);
          Serp(x2n, y2n, x2, y2, n-1)
     End
End;
Begin
     SetWindowCaption('Фракталы: Ковер Серпинского');
     SetWindowSize(500,500);
     ClearWindow;
     Rectangle(20, 20, 460, 460);
     Serp(20, 20, 460, 460, Z);
     Repeat Until Keypressed
End.

4. Снежинка Коха

program sneg;
uses GraphABC;

    procedure Draw(x, y, l, u : Real; t : Integer);
   procedure Draw2(Var x, y: Real; l, u : Real; t : Integer);
begin
   Draw(x, y, l, u, t);
   x := x + l*cos(u);
   y := y - l*sin(u);
   end;

   begin
   if t > 0 then
   begin
   l := l/3;
   Draw2(x, y, l, u, t-1);
   Draw2(x, y, l, u+pi/3, t-1);
   Draw2(x, y, l, u-pi/3, t-1);
   Draw2(x, y, l, u, t-1);
   end
   else
   Line(Round(x), Round(y), Round(x+cos(u)*l), Round(y-sin(u)*l))
   end;
   begin
   SetWindowSize(425,500);
   SetWindowCaption('Фракталы: Снежинка Коха');
   Draw(10, 354, 400, pi/3, 5);
   Draw(410, 354, 400, pi, 2);
   Draw(210, 8, 400, -pi/3, 4);
   end.

5. Множество Мандельброта

program Mandelbrot;
uses GraphABC;
const
n=255;
max=10;
var
x,y,x1,y1,cx,cy: real;
i,ix,iy: integer;
// z=z^2+c
begin
SetWindowSize(400,300);
SetWindowCaption('Фракталы: множество Мандельброта');
for ix:=0 to WindowWidth-1 do
for iy:=0 to WindowHeight-1 do
begin
    x:=0;
    y:=0;
    cx:=0.002*(ix-720);
    cy:=0.002*(iy-150);
    for i:=1 to n do
    begin
      x1:=x*x-y*y+cx;
      y1:=2*x*y+cy;
      if (x1>max) or (y1>max) then break;
      x:=x1;
      y:=y1;
    end;
    if i>=n then SetPixel(ix,iy,clRed)
      else SetPixel(ix,iy,RGB(255,255-i,255-i));
end;
end.

Вход на сайт

Поиск

Календарь

Архив записей
2017 Сентябрь 2017 Октябрь 2017 Ноябрь 2018 Февраль 2018 Март 2018 Сентябрь 2019 Май 2019 Сентябрь 2020 Август 2022 Сентябрь

Друзья сайта
Официальный блог Сообщество uCoz FAQ по системе Инструкции для uCoz

Создать бесплатный сайт с uCoz

Сайт учителя математики и информатики МБОУ Школа №126 Прониной Н.А.

Фракталы - Pascal ABC