Приложение Б
П р и л о ж е н и е 2
Тексты программ для построения фрактальных
изображений
Программа для построения фрактала Мандельброта
Program fr_mandelbrot;
uses crt,graph;
const mi=511;
var gd,gm:integer;
function c(index:integer):integer; {определение цвета точки}
begin
Рекомендуемые материалы
c:=1*(mi-index)
end;
{** функция подсчета количества итераций **}
function iteration(x,y:double):integer;
var i:integer; xx,yy,xk,yk:double;
begin
xx:=x; yy:=y; i:=0;
while (sqr(xx)+sqr(yy)<=4) do
begin
xk:=sqr(xx)-sqr(yy)+x;
yk:=2*xx*yy+y;
xx:=xk; yy:=yk; i:=i+1;
if i>=mi then break
end;
iteration:=i;
end;
{*** процедура формирования фрактала ***}
procedure mand(xx,yy,cx,cy:integer; minx,maxx,miny,maxy:double);
var stepx, stepy,x,y:double; i,j,iter:integer;
begin
stepx:=(maxx-minx)/cx;
stepy:=(maxy-miny)/cy;
y:=miny;
for j:=0 to cy do
begin
x:=minx;
for i:=0 to cx do
begin
iter:=iteration(x,y);
putpixel(xx+i,yy+j,c(iter));
x:=x+stepx;
end;
y:=y+stepy
end;
end;
begin
gd:=Detect;
initgraph(gd,gm,'C:BPBGI');
setBkcolor(1);
{формирование фрактала с разной степенью детализации}
mand(0,0,640,480,-2.2,1,-1.2,1.2); {весь фрактал}
readkey;
cleardevice;
{увеличенные фрагменты фрактала}
mand(0,0,640,480,-0.85,-0.7,0.1,0.25);
readkey;
cleardevice;
mand(0,0,640,480,-0.8,-0.7,0.2,0.3);
readkey;
cleardevice;
mand(0,0,640,480,-1.25,-1,-0.5,-0.25);
readkey;
cleardevice;
mand(0,0,640,480,-1.05,-1,-0.35,-0.3);
readkey;
closegraph;
end.
Программа для построения фрактала Джулиа
Program fr_Julia;
uses crt,graph;
const mi=511;
var gd,gm:integer;
function c(index:integer):integer; {определение цвета точки}
begin
c:=7*(mi-index)
end;
{** функция подсчета количества итераций **}
function iteration(x,y:double):integer;
const cx=0.36;cy=0.36;
var i:integer; xx,yy,xk,yk:double;
begin
xx:=x; yy:=y; i:=0;
while (sqr(xx)+sqr(yy)<=4) do
begin
xk:=sqr(xx)-sqr(yy)+cx;
yk:=2*xx*yy+cy;
xx:=xk; yy:=yk; i:=i+1;
if i>=mi then break
end;
iteration:=i;
end;
{*** процедура формирования фрактала ***}
procedure julia(xx,yy,cx,cy:integer; minx,maxx,miny,maxy:double);
var stepx, stepy,x,y:double; i,j,iter:integer;
begin
stepx:=(maxx-minx)/cx;
stepy:=(maxy-miny)/cy;
y:=miny;
for j:=0 to cy do
begin
x:=minx;
for i:=0 to cx do
begin
iter:=iteration(x,y);
putpixel(xx+i,yy+j,c(iter));
x:=x+stepx;
end;
y:=y+stepy
end;
end;
begin
gd:=Detect;
initgraph(gd,gm,'C:BPBGI');
setBkcolor(1);
{формирование фрактала с разной степенью детализации}
julia(0,0,640,480,-1,1,-1.2,1.2); {весь фрактал}
readkey;
cleardevice;
{увеличенные фрагменты фрактала}
julia(0,0,640,480,-0.1,0.1,-0.1,0.1);
readkey;
cleardevice;
julia(0,0,640,480,-1,0,-1.2,0);
readkey;
cleardevice;
julia(0,0,640,480,-1,-0.5,-0.5,0);
readkey;
cleardevice;
julia(0,0,640,480,-0.75,-0.06,-0.5,-0.35);
readkey;
cleardevice;
julia(0,0,640,480,-0.68,-0.65,-0.37,-0.36);
readkey;
closegraph;
end.
Программа для построения фрактала Кох
Program fr_kox;
uses graph,crt;
var x0,y0,x,y,gd,gm:integer;x1,y1:real;
{*** рекурсивная процедура построения линии Коха ***}
procedure kox(xn,yn,xk,yk:real);
var x2,y2,x3,y3,x4,y4:real; c:char;
begin
if abs(xn-xk)<2 then exit;
x2:=xn+(xk-xn)/3; y2:=yn+(yk-yn)/3;
x3:=xn+(xk-xn)*2/3; y3:=yn+(yk-yn)*2/3;
x4:=x2+(x3-x2)*cos(pi/3)+(y3-y2)*sin(pi/3);
y4:=y2-(x3-x2)*sin(pi/3)+(y3-y2)*cos(pi/3);
line(round(x2),round(y2),round(x4),round(y4));
line(round(x3),round(y3),round(x4),round(y4));
if keypressed then halt;
kox(xn,yn,x2,y2); {рекурсивные вызовы}
kox(x2,y2,x4,y4);
kox(x4,y4,x3,y3);
kox(x3,y3,xk,yk);
end;
begin
x0:=50; y0:=250;
x:=590; y:=250;
gd:=Detect;
initgraph(gd,gm,'C:BPBGI');
setcolor(10);
line(x0,y0,x,y);
kox(x0,y0,x,y); {Рисование фрактала - линии Коха}
readkey;
cleardevice;
{Рисование фрактального треугольника с использованием}
{процедуры для построения линии Коха}
x0:=150; y0:=320;
x:=490; y:=320;
x1:=x0+(x-x0)*cos(pi/3)+(y-y0)*sin(pi/3);
y1:=y0-(x-x0)*sin(pi/3)+(y-y0)*cos(pi/3);
kox(x0,y0,x1,y1);
kox(x1,y1,x,y);
kox(x,y,x0,y0);
readkey;
closegraph
end.
Программа для построения ветки папоротника
Program fr_paporotnik;
uses crt, graph;
const alfa=80;beta=2.1; k=0.3; k1=0.5; lmin=1;
var a,b,c,d,e,f,g,h:real; gd,gm:integer;
{*** рекурсивная процедура на основе метода IFS ***}
procedure step(x1,y1,x2,y2:real; nom:integer);
var x3,y3,x4,y4,x5,y5,x6,y6,x7,y7:real;
begin
if sqr(x1-x2)+sqr(y1-y2)>lmin then
begin
{координаты точек вычисляются по формулам}
x3:=(x2-x1)*a-(y2-y1)*b+x1; y3:=(x2-x1)*b+(y2-y1)*a+y1;
x4:=x1*c+x3*d; y4:=y1*c+y3*d;
x5:=x4*e+x3*f; y5:=y4*e+y3*f;
x6:=(x5-x4)*g-(y5-y4)*h+x4; y6:=(x5-x4)*h+(y5-y4)*g+y4;
x7:=(x5-x4)*g+(y5-y4)*h+x4; y7:=(x5-x4)*(-h)+(y5-y4)*g+y4;
line(round(x1),round(y1),round(x4),round(y4));
{рекурсивные вызовы для рисования фрагментов фрактала}
step(x4,y4,x3,y3,nom);
step(x4,y4,x6,y6,nom+1);
step(x4,y4,x7,y7,nom+1);
end;
end;
begin
gd:=Detect;
initgraph(gd,gm,'C:BPBGI');
setBkcolor(1);
{вычисление коэффициентов}
a:=cos(pi/alfa); b:=sin(pi/alfa);
c:=1-k; d:=k;
e:=1-k1; f:=k1;
g:=cos(pi/beta); h:=sin(pi/beta);
step(200,350,225,70,0); {рисование ветки папоротника}
readkey;
closegraph
end.
Программа построения треугольника Серпинского
program fr_treug_serpinsky;
uses graph,crt;
const m=2500; { количество точек фрактала }
type koord=array[1..3] of integer;
var gd,gm: integer;
x,y: koord; { массивы координат }
{**** Процедура заполнения заданного треугольника точками ****}
procedure serpinsky(xs,ys:koord);
var x0,y0,xk,yk: real; n,k: integer;
begin
randomize;
x0:=(xs[1]+xs[2]+xs[3])/3; { координаты начальной точки }
y0:=(ys[1]+ys[2]+ys[3])/3;
for k:=1 to m do
begin
n:=random(3)+1; { случайная вершина }
xk:=(x0+xs[n])/2; { середина отрезка, соединяющего }
yk:=(y0+ys[n])/2; { начальную точку с вершиной }
putpixel(round(xk), round(yk), 12); { вывод точки }
x0:=xk; { новые координаты для начальной точки }
y0:=yk
end;
end;
begin
gd:=Detect;
initgraph(gd,gm,'C:BPBGI');
setcolor(10);
setviewport(20,20,500,250, true);
x[1]:=320; y[1]:=50; { координаты вершин треугольника }
Ещё посмотрите лекцию "Злокачественные опухоли яичников" по этой теме.
x[2]:=150; y[2]:=200;
x[3]:=450; y[3]:=200;
serpinsky(x,y); { процедура вывода треугольника Серпинского }
readkey;
closegraph
end.
