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

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

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

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

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

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

Итерация	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

Губка Менгера в разрезе

Сечение Губки Менгера плоскостью $1.5x+1.5y+1.5z=0$ содержит гексаграммы.

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

CUTPLANE 1.5, 1.5, 1.5
	PLACEGROUP Menger
CUTEND

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

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

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

Рекурсивный алгоритм описывает 3D-матрицу, по которой строится каждая итерация губки Менгера: ${\begin{pmatrix}1&1&1\\1&0&1\\1&1&1\end{pmatrix}}$ ${\begin{pmatrix}1&0&1\\0&0&0\\1&0&1\end{pmatrix}}$ ${\begin{pmatrix}1&1&1\\1&0&1\\1&1&1\end{pmatrix}}$

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

Итерация	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.
В столбце "Тип" выбираем выпадающий значок "Целое число".
Имя - любое. Например, "Число итераций".
Значение - целое число от 1 до 4 в зависимости от мощности Вашего компьютера.
Переходим в 3D-скрипт. В левом ряду больших кнопок находим кнопку "3D Скрипт" или "3D" в зависимости от версии перевода.
Вставляем код, который ниже.
Открываем окно 3D-проекции. Маленькая кнопка "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-систем

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

Задаются 20 точек-аттракторов: 8 вершин и 12 середин рёбер исходного куба.
Задаётся некоторая начальная точка $P_{0}$ , лежащая внутри куба.
Случайно выбирается аттрактор $A_{i}$ из 20 возможных с равной вероятностью.
Строится точка $P_{i}$ с новыми координатами: $x_{i}={\frac {x_{i-1}+2x_{A}}{3}};y_{i}={\frac {y_{i-1}+2y_{A}}{3}};z_{i}={\frac {z_{i-1}+2z_{A}}{3}}$ , где: $x_{i-1},y_{i-1},z_{i-1}$ — координаты предыдущей точки $P_{i-1}$ ; $x_{A},y_{A},z_{A}$ — координаты выбранного аттрактора.
Повторить с пункта 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

См. также