Реализации алгоритмов/Губка Менгера

Материал из Викиучебника — открытых книг для открытого мира
Перейти к навигации Перейти к поиску
Губка Менгера

Губка Менгера — геометрический фрактал, один из трёхмерных аналогов ковра Серпинского.

Построение итеративным методом на GDL для ArchiCAD[править]

Алгоритм итеративного метода основан на операции твердотельного вычитания (subtraction). В языке GDL такая операция реализуется с помощью групп (group).

  1. Строится группа-"уменьшаемое". Она состоит из одного единичного куба (стороной 1 и одной из вершин в начале координат).
  2. Строится группа-"вычитаемое". Она включает фронтальные, горизонтальные и профильные "стержни", которые будут вычитаться из куба. Размер и количество зависит от итерации.
  3. Проводится операция твердотельного вычитания.

Данный метод весьма требователен к ресурсам:

Итерация 1 2 3 4
Граней в результате операции 30 414 6848 125162
Треугольников в результате операции 60 828 13696 250324
Рёбер в результате операции 72 984 16920 317920

Код оптимизирован под наглядность, а не производительность. В среде ArchiCAD 19 и 20 корректно исполняются 4 итерации. В среде ArchiCAD 13 (64 бит) корректно исполняются только 2 итерации.

В среде ArchiCAD вызываем интерфейс разработки библиотечных объектов (Ctrl+Shift+O). На вкладке «Параметры» задаём целую переменную i – число итераций.

Переходим в 3D-скрипт.

!!!3D Script

MulX A
MulY B
MulZ ZZYZX

GROUP "InitialCube"
	BLOCK 1, 1, 1
ENDGROUP

GROUP "Rods"
	FOR n = 1 TO i
		MulX 1/3
		MulY 1/3
		AddX 1
		AddY 1
		FOR ny = 1 TO 3^(n-1)
			FOR nx = 1 TO 3^(n-1)
				BLOCK 1, 1, 1
				AddX 3
			NEXT nx
			DEL 3^(n-1)
			AddY 3
		NEXT ny
		DEL 3^(n-1)
		AddY -1
		AddX -1
	NEXT n
ENDGROUP

GROUP "Graphite"
	PLACEGROUP "Rods"
	RotX 90
	AddZ -1
	PLACEGROUP "Rods"
	RotY 90
	AddX -1
	PLACEGROUP "Rods"
ENDGROUP

Menger = SUBGROUP("InitialCube", "Graphite")

PLACEGROUP Menger

KILLGROUP "InitialCube"
KILLGROUP "Rods"
KILLGROUP "Graphite"
KILLGROUP Menger
Губка Менгера в разрезе

Сечение Губки Менгера плоскостью содержит гексаграммы.

Для получения соответствующего разреза нужно рисовать только ту часть, которая расположена ниже этой плоскости, т.е. наложить условие:

CUTPLANE 1.5, 1.5, 1.5
	PLACEGROUP Menger
CUTEND

Построение рекурсивным методом на GDL для ArchiCAD[править]

Поскольку язык GDL не предполагает процедур, для рекурсии используем переходы по меткам.

  1. Сразу переходим на i-ю метку
  2. i-я метка устанавливает параметры для метки (i-1) и переходит на метку рекурсивного алгоритма
  3. Метка рекурсивного алгоритма устанавливает позицию (x, y, z) и переходит на метку i-1
  4. ...
  5. Метка 0 строит единичный куб

Рекурсивный алгоритм описывает 3D-матрицу, по которой строится каждая итерация губки Менгера:

Алгоритм рекурсивного составления исполняется быстрее, чем алгоритм итеративного вычитания. Но он также требователен к ресурсам:

Итерация 0 1 2 3 4 5 6 7 8 9 10
Кубов 1 20 400 8K 160K 3.2M 64M 1.28G 25.6G 512G 10.24T
Граней 6 120 2.4K 48K 960K 19.2M 384M 7.68G 153.6G 3.072T 61.44T
Треугольников 12 240 4.8K 96K 1.92K 38.4M 768M 15.36G 307.2G 6.144T 122.88T
Рёбер 12 240 4.8K 96K 1.92K 38.4M 768M 15.36G 307.2G 6.144T 122.88T
Вершин 8 160 3.2K 64K 1.28M 25.6M 512M 10.24G 204.8G 4.096T 81.92T

Код оптимизирован под наглядность, а не производительность. В среде ArchiCAD 13, 19 и 20 корректно исполняются 4 итерации. Оптимальны для работы 3 итерации.

Для визуализации вместо старших итераций можно использовать текстуру ковра Серпинского

В среде ArchiCAD вызываем интерфейс разработки библиотечных объектов (Ctrl+Shift+O). На вкладке «Параметры» задаём целую переменную i – число итераций.

Переходим в 3D-скрипт.

!!!3D Script

MulX A/(3^i)
MulY B/(3^i)
MulZ ZZYZX/(3^i)

GOSUB i

END

4:
	n = 3
	d = 27
	GOSUB 100
RETURN

3:
	n = 2
	d = 9
	GOSUB 100
	n = 3
	d = 27
RETURN

2:
	n = 1
	d = 3
	GOSUB 100
	n = 2
	d = 9
RETURN

1:
	n = 0
	d = 1
	GOSUB 100
	n = 1
	d = 3
RETURN

0:
	BLOCK 1,1,1
RETURN

100:
	GOSUB n		!111
	AddX d		!1: 2,1,1
	GOSUB n		!211
	AddX d		!2: 3,1,1
	GOSUB n		!311
	DEL 2		!0: 1,1,1

	AddY d		!1: 1,2,1
	GOSUB n		!121
	AddX 2*d	!2: 3,2,1
	GOSUB n		!321
	DEL 1		!1: 1,2,1

	AddY d		!2: 1,3,1
	GOSUB n		!131
	AddX d		!3: 2,3,1
	GOSUB n		!231
	AddX d		!4: 3,3,1
	GOSUB n		!331
	DEL 4		!0: 1,1,1

	AddZ d		!1: 1,1,2
	GOSUB n		!112
	AddX 2*d	!2: 3,1,2
	GOSUB n		!312
	DEL 1		!1: 1,1,2

	AddY 2*d	!2: 1,3,2
	GOSUB n		!132
	AddX 2*d	!3: 3,3,2
	GOSUB n		!332
	DEL 2		!1: 1,1,2

	AddZ d		!2: 1,1,3
	GOSUB n		!113
	AddX d		!3: 2,1,3
	GOSUB n		!213
	AddX d		!4: 3,1,3
	GOSUB n		!313
	DEL 2		!2: 1,1,3

	AddY d		!3: 1,2,3
	GOSUB n		!123
	AddX 2*d	!4: 3,2,3
	GOSUB n		!323
	DEL 1		!3: 1,2,3

	AddY d		!4: 1,3,3
	GOSUB n		!133
	AddX d		!5: 2,3,3
	GOSUB n		!233
	AddX d		!6: 3,3,3
	GOSUB n		!333
	DEL 6		!0
RETURN

Построение методом хаоса на VBA для CAD-систем[править]

Алгоритм построения:

  1. Задаются 20 точек-аттракторов: 8 вершин и 12 середин рёбер исходного куба.
  2. Задаётся некоторая начальная точка , лежащая внутри куба.
  3. Случайно выбирается аттрактор из 20 возможных с равной вероятностью.
  4. Строится точка с новыми координатами: , где: — координаты предыдущей точки ; — координаты выбранного аттрактора.
  5. Повторить с пункта 3.

Строится губка Менгера с центром в начале координат и ребром 1, т.е. каждая вершина удалена от центра на 0.5 по оси x, на 0.5 по оси y и на 0.5 по оси z.

Sub Sponge()

Dim pointObj As AcadPoint
Dim P(1 To 3) As Double

Dim i As Long           'Iteration Number
Dim R As Integer        'Random Number

Dim A(1 To 20, 1 To 3) As Double
'Due to Code optimization we'll multiply all coordinates by 2
'so the formula P(1) = (P(1) + 2*A(R, 1)) / 3
'will be reduced to P(1) = (P(1) + A(R, 1)) / 3
'Bottom
A(1, 1) = -1        '-1 = 2 * (-0.5)
A(1, 2) = -1
A(1, 3) = -1
A(2, 1) = -1
A(2, 2) = 0         '0 = 2 * 0
A(2, 3) = -1
A(3, 1) = -1
A(3, 2) = 1
A(3, 3) = -1
A(4, 1) = 0
A(4, 2) = 1
A(4, 3) = -1
A(5, 1) = 1
A(5, 2) = 1
A(5, 3) = -1
A(6, 1) = 1
A(6, 2) = 0
A(6, 3) = -1
A(7, 1) = 1
A(7, 2) = -1
A(7, 3) = -1
A(8, 1) = 0
A(8, 2) = -1
A(8, 3) = -1
'Middle
A(9, 1) = -1
A(9, 2) = -1
A(9, 3) = 0
A(10, 1) = -1
A(10, 2) = 1
A(10, 3) = 0
A(11, 1) = 1
A(11, 2) = 1
A(11, 3) = 0
A(12, 1) = 1
A(12, 2) = -1
A(12, 3) = 0
'Top
A(13, 1) = -1
A(13, 2) = -1
A(13, 3) = 1
A(14, 1) = -1
A(14, 2) = 0
A(14, 3) = 1
A(15, 1) = -1
A(15, 2) = 1
A(15, 3) = 1
A(16, 1) = 0
A(16, 2) = 1
A(16, 3) = 1
A(17, 1) = 1
A(17, 2) = 1
A(17, 3) = 1
A(18, 1) = 1
A(18, 2) = 0
A(18, 3) = 1
A(19, 1) = 1
A(19, 2) = -1
A(19, 3) = 1
A(20, 1) = 0
A(20, 2) = -1
A(20, 3) = 1

For i = 1 To 1000000            'Million iterations may take a long time
 R = Int((20 * Rnd) + 1)
'Using reduced formula with respect to pre-scaled coordinates
 P(1) = (P(1) + A(R, 1)) / 3
 P(2) = (P(2) + A(R, 2)) / 3
 P(3) = (P(3) + A(R, 3)) / 3

Set pointObj = ThisDrawing.ModelSpace.AddPoint(P)
Next i

ZoomExtents
End Sub

См. также[править]