Матрица статей        Список статей        Всячина        Контакты       

Фракталы из многоугольников

program P4;

uses CRT, Graph;

const
	Min = 2;
	
var
	gd, gm : Integer;

procedure Draw(x, y : Real; Size : Real);

var
	s : Real;
	
begin
	if Size > Min then 
	begin
		s := Size / 2;
		Draw(x - Size, y + Size, s);
		Draw(x - Size, y - Size, s);
		Draw(x + Size, y + Size, s);
		Draw(x + Size, y - Size, s);
	end;
	Rectangle(Round(x - Size), Round(y - Size), 
		Round(x + Size), Round(y + Size));
	Bar(Round(x - Size + 1), Round(y - Size + 1), 
		Round(x + Size - 1), Round(y + Size - 1));
end;

begin
	gd := Detect;
	InitGraph(gd, gm, '');
	SetFillStyle(SolidFill, 0);
	Draw(320, 240, 120);
	ReadKey;
	CloseGraph;
end.

Фракталы из многоугольников

...
begin
	gd := Detect;
	InitGraph(gd,gm,'c:\bp\bgi');
	SetFillStyle(SolidFill,0);
	SetColor(15);
	Sraw(320,240,120);
	ReadLn;
	SetWriteMode(XORPut);
	SetColor(0);
	Draw(320, 240, 120);
	ReadLn;
	CloseGraph;
end.

uses crt,graph;

const
	MinSize=0;
  
var
	gd, gm : Integer;

procedure Triangle(xc, yc : Integer; l : integer);

var
  x1, y1, x2, y2, x3, y3 : Integer;
  
Begin
  x1 := xc;
  y1 := yc - l;
  x2 := xc + Round(l*cos(pi/6));
  y2 := yc + Round(l*sin(pi/6));
  x3 := xc - Round(l*cos(pi/6));
  y3 := yc + Round(l*sin(pi/6));
  SetColor(1);
  Line(x1, y1, x2, y2);
  Line(x2, y2, x3, y3);
  Line(x3, y3, x1, y1);
  FloodFill(xc, yc, 1);
  SetColor(15);
  Line(x1, y1, x2, y2);
  Line(x2, y2, x3, y3);
  Line(x3, y3, x1, y1);
End;

procedure Draw(x, y : Integer; Size : Word);

var 
	s : Word;
begin
	if Size > MinSize then 
	begin
		s := Size div 2;
		Draw(x, y - Size, s);
		Draw(x + Round(Size * cos(pi/6)), y + Round(Size * sin(pi/6)), s);
		Draw(x - Round(Size * cos(pi/6)), y + Round(Size*sin(pi/6)), s);
	end;
	Triangle(x, y, Size);
end;

begin
	gd := Detect;
	InitGraph(gd, gm, 'c:\bp\bgi');
	Draw(320,280,120);
	ReadKey;
	CloseGraph;
end.

Фракталы из многоугольников

Следующая программа обобщает все случаи правильных многоугольников. Здесь — число сторон в многоугольнике, — коэффициент уменьшения.

program Polygon;

uses CRT, Graph;

const
	n = 5;     {3, 1/2} {4, 1/2} {5, 3/8} {6, 1/3} {7, 3/10}
	t = 3/8;
	
type
	PolyPoints = array [1..n + 1] of PointType;

procedure Draw(x, y, s : Integer; r : Byte);

var
	i : Integer;
	p : PolyPoints;
	a : Real;
  
begin
	if r = 0 then 
		Exit;
	a := (360 / n + 0) * (pi / 180);
	for i := 1 to n do 
	begin
		p[i].x := x + Round(cos(a * i) * s / 2);
		p[i].y := y + Round(sin(a * i) * s / 2);
	end;
	p[n + 1] := p[1];
	for i := 1 to n do 
		Draw(p[i].x, p[i].y, Round(s*t), r - 1);
	FillPoly(n + 1, p);
end;

var
  gd, gm : Integer;
  
begin
	gd := Detect;
	InitGraph(gd, gm, 'c:\bp\bgi');
	SetLineStyle(0, 0, 0);
	SetFillStyle(1, 0);
	Draw(320, 240, 300, 6);
	ReadKey;
	CloseGraph;
end.

Можно рассматривать не сами многоугольники, а только предельные точки, для этого построим соответствующие системы итерируемых функций. Несложно заметить, что искомые аффинные преобразования, записанные в комплексной форме, имеют вид:

package polygons;

import java.awt.BorderLayout;
import java.awt.Graphics;
import java.util.Random;
import javax.swing.JFrame;
import javax.swing.JPanel;
import static java.lang.Math.PI;
import static java.lang.Math.sin;
import static java.lang.Math.cos;

public class Main
{
	private static final int COUNT = 100000;
	private static final int BEGIN = 1000;

	private static JPanel centerPanel = new JPanel()
	{
		private void drawPoint(double x, double y, Graphics graph, 
			int scale, int dx, int dy)
		{
			int screenX = (int)(dx + x * scale);
			int screenY = (int)(dy - y * scale);
			graph.drawLine(screenX, screenY, screenX, screenY);
		}

		private void drawPolygons(int n, double r, Graphics graph, 
			int scale, int dx, int dy)
		{
			Random random = new Random();
			double x = 0;
			double y = 0;
			double t;
			double alpha = 2 * PI / n;
			int k;
			
			for (int i = 0; i < COUNT; ++i)
			{
				k = random.nextInt(n);
				t = x;
				x = r * cos(alpha * k) * (x + 1) - r * sin(alpha * k) * y;
				y = r * sin(alpha * k) * (t + 1) + r * cos(alpha * k) * y;
				if (i < BEGIN)
					continue;
				drawPoint(x, y, graph, scale, dx, dy);
			}
		}

		@Override
		public void paintComponent(Graphics graph)
		{
			super.paintComponent(graph);
			drawPolygons(3, 0.5, graph, 250, 512, 390);
		}
	};

	public static void main(String[] args)
	{
		JFrame frame = new JFrame();
		frame.addNotify();
		frame.setSize(frame.getInsets().left +
		frame.getInsets().right + 1024,
		frame.getInsets().top +
		frame.getInsets().bottom + 780);
		frame.setDefaultCloseOperation(JFrame.EXIT_ON_CLOSE);
		frame.setLayout(new BorderLayout());
		frame.add(centerPanel, BorderLayout.CENTER);
		frame.setVisible(true);
	}
}

Фракталы из многоугольников Фракталы из многоугольников Фракталы из многоугольников


Фрактальный пятиугольник

program Penta;

uses CRT, Graph;

procedure Draw(x, y, r, a: Real);

var
	i: Integer;
	xx, yy: array [0..5] of Real;
begin
	for i := 0 to 5 do 
	begin
		xx[i] := r*cos(a + i*pi*2/5);
		yy[i] := r*sin(a + i*pi*2/5);
	end;
	for i := 0 to 4 do 
	begin
		Line(Round(x + xx[i]),   Round(y + yy[i]),
			Round(x + xx[i+1]), Round(y + yy[i+1]));
	end;
end;

procedure ProvRis(x, y, r, a: Real; d: Integer);

var
	i: Integer;
	h: Real;

begin
	h := 2*r*cos(pi/5);
	for i := 0 to 4 do 
	begin
		Draw(x - h*cos(a+i*pi*2/5), y - h*sin(a+i*pi*2/5), 
			r, a + pi + i*pi*2/5);
		if d > 0 then
			ProvRis(x - h*cos(a+i*pi*2/5), y - h*sin(a+i*pi*2/5),
				r/(2*cos(pi/5)+1), a+pi+(2*i+1)*pi*2/10, d-1);
	end;
	Draw(x, y, r, a);
	if d > 0 then 
		ProvRis(x, y, r/(2*cos(pi/5)+1), a+pi, d-1);
end;

var
	gd, gm: Integer;
	
begin
	gd := Detect;
	InitGraph(gd, gm, 'c:\bp\bgi');
	ProvRis(320, 260, 95, pi/2, 3);
	ReadKey;
	CloseGraph;
end.

Приведенная выше программа написана Аслановым А.М.


Фрактальный пятиугольник

Можно не рисовать промежуточные пятиугольники.

program Penta1;

uses CRT, Graph;

procedure Draw(x, y, r, a: Real);

var
	i: Integer;
	xx, yy: Array [0..5] of Real;
	
begin
	for i := 0 to 5 do 
	begin
		xx[i] := r*cos(a + i*pi*2/5);
		yy[i] := r*sin(a + i*pi*2/5);
	end;
	for i := 0 to 4 do 
	begin
		Line(Round(x + xx[i]),   Round(y + yy[i]),
			Round(x + xx[i+1]), Round(y + yy[i+1]));
	end;
end;

procedure ProvRis(x, y, r, a: Real; d: Integer);

var
	i: Integer;
	h: Real;
begin
	h := 2*r*cos(pi/5);
	for i := 0 to 4 do
		if d > 0 then 
			ProvRis(x - h*cos(a+i*pi*2/5), y - h*sin(a+i*pi*2/5),
				r/(2*cos(pi/5)+1), a+pi+(2*i+1)*pi*2/10, d-1)
		else 
			Draw(x - h*cos(a+i*pi*2/5), y - h*sin(a+i*pi*2/5),
				r, a + pi + i*pi*2/5);
		if d > 0 then 
			ProvRis(x, y, r/(2*cos(pi/5)+1), a+pi, d-1)
		else 
			Draw(x, y, r, a);
End;

var
	gd, gm: Integer;

begin
	gd := Detect;
	InitGraph(gd, gm, 'c:\bp\bgi');
	ProvRis(320, 260, 95, pi/2, 3);
	ReadKey;
	CloseGraph;
end.

Смотрите также:

Ссылки: