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

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

Аналогично салфетке Серпинского можно строить ковер Серпинского (Sierpinski carpet), который является двуxмерным аналогом канторовского множества исключенных средних третей. Строится ковер Серпинского следующим образом. Вначале берётся квадрат со стороной равной единице, затем каждая сторона квадрата делится на три равные части, а весь квадрат, соответственно, на девять одинаковых квадратиков со стороной равной . Из полученной фигуры вырезается центральный квадрат. Затем такой же процедуре подвергается каждый из 8 оставшихся квадратиков и т. д.


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

program Sierp4;
uses CRT, Graph;
var
	gd, gm: Integer;
	x1, y1, x2, y2, x3, y3: Real;

procedurue 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
	gd := Detect;
	InitGraph(gd, gm, 'c:\bp\bgi');
	Rectangle(20, 20, 460, 460);
	Serp(20, 20, 460, 460, 4);
	ReadLn;
	CloseGraph;
end.

Рассмотрим обобщение ковра Серпинского. Идея такова. Берётся единичный квадрат, который делится на девять частей. Некоторые из этих частей выбрасываются. К оставшимся применяется аналогичная процедура.


Обобщение ковра Серпинского Обобщение ковра Серпинского Обобщение ковра Серпинского Обобщение ковра Серпинского

program Cantor10;
uses CRT, Graph;
var
    gd, gm, i, j           : Integer;
    x1, y1, x2, y2, x3, y3 : Real;
    A                      : array [1..3, 1..3] of Boolean;
    Key                    : Char;

function BR : Boolean;
begin
    if Random > 0.5 then
        BR := true
    else
        BR := false
end;


procedure Sierp(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;
        {if n = 1 then} Rectangle(round(x1),round(y1),round(x2),round(y2));
        if A[1,1] then Sierp(x1,  y1,  x1n, y1n, n-1);
        if A[1,2] then Sierp(x1n, y1,  x2n, y1n, n-1);
        if A[1,3] then Sierp(x2n, y1,  x2,  y1n, n-1);
        if A[2,1] then Sierp(x1,  y1n, x1n, y2n, n-1);
        if A[2,2] then Sierp(x1n, y1n, x2n, y2n, n-1);
        if A[2,3] then Sierp(x2n, y1n, x2,  y2n, n-1);
        if A[3,1] then Sierp(x1,  y2n, x1n, y2,  n-1);
        if A[3,2] then Sierp(x1n, y2n, x2n, y2,  n-1);
        if A[3,3] then Sierp(x2n, y2n, x2,  y2,  n-1)
    end
end;


begin
    gd:=detect;
    InitGraph(gd, gm, 'c:\bp\bgi');
    Randomize;
    repeat
        ClearDevice;
        for i:=1 to 3 do
            for j:=1 to 3 do A[i,j] := BR;
        Sierp(1, 1, 1+9*9*5, 1+9*9*5, 5);
        Key := ReadKey
    until Key = #27;
    CloseGraph
end.

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

Ссылки: