Реализации алгоритмов/Губка Менгера: различия между версиями

Содержимое удалено Содержимое добавлено
Строка 83:
 
Dim pointObj As AcadPoint
Dim locationP(01 To 23) As Double
 
Dim i As Long 'Iteration Number
Dim R As Double Integer 'Random Number
 
Dim A(1 To 20, 1 To 3) As Double
For i = 1 To 1000000 'Million iterations may take a long time
'Due to Code optimization we'll multiply all coordinates by 2
R = Rnd(1)
'so the formula P(1) = (P(1) + 2*A(R, 1)) / 3
If R < 0.05 Then 'Step = 1 / 20, where 20 = 27 total - 7 empty
'will be reduced to locationP(01) = (locationP(01) -+ A(R, 1)) / 3 '0
'Bottom
location(1) = (location(1) - 1) / 3 'location(1) = (location(1) - 2*0.5) / 3
A(1, 1) = -1 '-1 = 2 * (-0.5)
location(2) = (location(2) - 1) / 3
A(1, 2) = -1
ElseIf R < 0.1 Then
A(1, 3) = -1
location(0) = (location(0) - 1) / 3 '1
A(2, 1) = -1
location(1) = location(1) / 3 'location(1) = (location(1) - 2*0) / 3
A(2, 2) = 0 '0 = 2 * 0
location(2) = (location(2) - 1) / 3
A(2, 3) = -1
ElseIf R < 0.15 Then
A(3, 1) = -1
location(0) = (location(0) - 1) / 3 '2
A(3, 2) = 1
location(1) = (location(1) + 1) / 3
A(3, 3) = -1
location(2) = (location(2) - 1) / 3
A(4, 1) = 0
ElseIf R < 0.2 Then
A(4, 2) = 1
location(0) = location(0) / 3 '3
A(4, 3) = -1
location(1) = (location(1) + 1) / 3
A(5, 1) = 1
location(2) = (location(2) - 1) / 3
A(5, 2) = 1
ElseIf R < 0.25 Then
A(5, 3) = -1
location(0) = (location(0) + 1) / 3 '4
A(6, 1) = 1
location(1) = (location(1) + 1) / 3
A(6, 2) = 0
location(2) = (location(2) - 1) / 3
A(6, 3) = -1
ElseIf R < 0.3 Then
A(7, 1) = 1
location(0) = (location(0) + 1) / 3 '5
A(7, 2) = -1
location(1) = location(1) / 3
A(7, 3) = -1
location(2) = (location(2) - 1) / 3
A(8, 1) = 0
ElseIf R < 0.35 Then
A(8, 2) = -1
location(0) = (location(0) + 1) / 3 '6
A(8, 3) = -1
location(1) = (location(1) - 1) / 3
'Middle
location(2) = (location(2) - 1) / 3
A(9, 1) = -1
ElseIf R < 0.4 Then
A(9, 2) = -1
location(0) = location(0) / 3 '7
A(9, 3) = 0
location(1) = (location(1) - 1) / 3
A(10, 1) = -1
location(2) = (location(2) - 1) / 3
A(10, 2) = 1
ElseIf R < 0.45 Then
A(10, 3) = 0
location(0) = (location(0) - 1) / 3 '0
A(11, 1) = 1
location(1) = (location(1) - 1) / 3
A(11, 2) = 1
location(2) = location(2) / 3
'Vertex A(-111, 0, 03) is= Empty0
A(12, 1) = 1
'location(0) = (location(0) - 1) / 3 '1
A(12, 2) = -1
'location(1) = location(1) / 3
A(12, 3) = 0
'location(2) = location(2) / 3
'Top
ElseIf R < 0.5 Then
A(13, 1) = -1
location(0) = (location(0) - 1) / 3 '2
A(13, 2) = -1
location(1) = (location(1) + 1) / 3
A(13, 3) = 1
location(2) = location(2) / 3
'Vertex A(014, 1, 0) is= Empty-1
A(14, 2) = 0
'location(0) = location(0) / 3 '3
A(14, 3) = 1
'location(1) = (location(1) + 1) / 3
A(15, 1) = -1
'location(2) = location(2) / 3
A(15, 2) = 1
ElseIf R < 0.55 Then
A(15, 3) = 1
location(0) = (location(0) + 1) / 3 '4
A(16, 1) = 0
location(1) = (location(1) + 1) / 3
A(16, 2) = 1
location(2) = location(2) / 3
'Vertex A(116, 0, 03) is= Empty1
A(17, 1) = 1
'location(0) = (location(0) + 1) / 3 '5
A(17, 2) = 1
'location(1) = location(1) / 3
A(17, 3) = 1
'location(2) = location(2) / 3
A(18, 1) = 1
ElseIf R < 0.6 Then
A(18, 2) = 0
location(0) = (location(0) + 1) / 3 '6
A(18, 3) = 1
location(1) = (location(1) - 1) / 3
A(19, 1) = 1
location(2) = location(2) / 3
'Vertex A(019, -1, 02) is= Empty-1
A(19, 3) = 1
'location(0) = location(0) / 3 '7
A(20, 1) = 0
'location(1) = (location(1) - 1) / 3
A(20, 2) = -1
'location(2) = location(2) / 3
A(20, 3) = 1
ElseIf R < 0.65 Then
location(0) = (location(0) - 1) / 3 '0
location(1) = (location(1) - 1) / 3
location(2) = (location(2) + 1) / 3
ElseIf R < 0.7 Then
location(0) = (location(0) - 1) / 3 '1
location(1) = location(1) / 3
location(2) = (location(2) + 1) / 3
ElseIf R < 0.75 Then
location(0) = (location(0) - 1) / 3 '2
location(1) = (location(1) + 1) / 3
location(2) = (location(2) + 1) / 3
ElseIf R < 0.8 Then
location(0) = location(0) / 3 '3
location(1) = (location(1) + 1) / 3
location(2) = (location(2) + 1) / 3
ElseIf R < 0.85 Then
location(0) = (location(0) + 1) / 3 '4
location(1) = (location(1) + 1) / 3
location(2) = (location(2) + 1) / 3
ElseIf R < 0.9 Then
location(0) = (location(0) + 1) / 3 '5
location(1) = location(1) / 3
location(2) = (location(2) + 1) / 3
ElseIf R < 0.95 Then
location(0) = (location(0) + 1) / 3 '6
location(1) = (location(1) - 1) / 3
location(2) = (location(2) + 1) / 3
Else
location(0) = location(0) / 3 '7
location(1) = (location(1) - 1) / 3
location(2) = (location(2) + 1) / 3
End If
 
For i = 1 To 1000000 'Million iterations may take a long time
Set pointObj = ThisDrawing.ModelSpace.AddPoint(location)
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