Реализации алгоритмов/Губка Менгера
![](http://upload.wikimedia.org/wikipedia/commons/thumb/a/ad/Menger-Schwamm.png/220px-Menger-Schwamm.png)
Губка Менгера — геометрический фрактал, один из трёхмерных аналогов ковра Серпинского.
Алгоритм итеративного метода основан на операции твердотельного вычитания (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
![](http://upload.wikimedia.org/wikipedia/commons/thumb/3/36/Menger4_Coupe.jpg/220px-Menger4_Coupe.jpg)
Сечение Губки Менгера плоскостью содержит гексаграммы.
Для получения соответствующего разреза нужно рисовать только ту часть, которая расположена ниже этой плоскости, т.е. наложить условие:
CUTPLANE 1.5, 1.5, 1.5
PLACEGROUP Menger
CUTEND
Поскольку язык GDL не предполагает процедур, для рекурсии используем переходы по меткам.
- Сразу переходим на i-ю метку
- i-я метка устанавливает параметры для метки (i-1) и переходит на метку рекурсивного алгоритма
- Метка рекурсивного алгоритма устанавливает позицию (x, y, z) и переходит на метку i-1
- ...
- Метка 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.
- В столбце "Тип" выбираем выпадающий значок "Целое число".
- Имя - любое. Например, "Число итераций".
- Значение - целое число от 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 середин рёбер исходного куба.
- Задаётся некоторая начальная точка , лежащая внутри куба.
- Случайно выбирается аттрактор из 20 возможных с равной вероятностью.
- Строится точка с новыми координатами: , где: — координаты предыдущей точки ; — координаты выбранного аттрактора.
- Повторить с пункта 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