Logo by stereoman - Contribute your own Logo!

END OF AN ERA, FRACTALFORUMS.COM IS CONTINUED ON FRACTALFORUMS.ORG

it was a great time but no longer maintainable by c.Kleinhuis contact him for any data retrieval,
thanks and see you perhaps in 10 years again

this forum will stay online for reference
News: Support us via Flattr FLATTR Link
 
*
Welcome, Guest. Please login or register. March 28, 2024, 06:32:35 PM


Login with username, password and session length


The All New FractalForums is now in Public Beta Testing! Visit FractalForums.org and check it out!


Pages: 1 [2]   Go Down
  Print  
Share this topic on DiggShare this topic on FacebookShare this topic on GoogleShare this topic on RedditShare this topic on StumbleUponShare this topic on Twitter
Author Topic: Evil queen and some other fractals  (Read 2773 times)
0 Members and 1 Guest are viewing this topic.
kaludix
Alien
***
Posts: 20



WWW
« Reply #15 on: February 07, 2016, 08:26:29 AM »

I played with the corrected Mandelbrot code and have two small mods that will decrease execution time by more than 4X.

(1) Data types need to be specified for each variable.  The line...
Dim i, j As Double
will define i as a Variant data type and j as a Double.  Variants are more expensive than Doubles.  This line and all lines like it should be in the form...
Dim i As Double, j As Double

(2) Using DoEvents is expensive and updating the screen is very expensive in Excel.  I modified the code to turn off the screen updating and inform the user of progress every 1% using the status bar.

Code:
Sub Grid()
With Range(Cells(1, 1), Cells(1900, 1900))
    .ColumnWidth = 0.08
    .RowHeight = 0.75
End With
End Sub
'----------------------------------------------------
Function iterateQueen(ByVal i As Double, j As Double)
Dim ien As Double, jen As Double, ienz As Double, jenz As Double
Dim xmag As Double, ymag As Double
Dim patri As Integer
xmag = i * i
ymag = j * j
ien = i
jen = j
patri = 1
For k = 1 To 1000
    jen = 2 * ien * jen + j
    ien = xmag - ymag + i
    xmag = ien * ien
    ymag = jen * jen
    If xmag + ymag > 4 Then
        patri = 0
        Exit For
    End If
Next k
iterateQueen = patri
End Function
'----------------------------------------------------
Sub drawMandelbrot()
Dim pocitadloi As Integer, pocitadloj As Integer
Dim i As Double, j As Double
Dim oldStatusBar As Boolean, k As Integer, numRows As Integer
'Dim timerStart As Single

' Initial application controls
'timerStart = Timer
With Application
    .ScreenUpdating = False
    oldStatusBar = .DisplayStatusBar
    .DisplayStatusBar = True
    .StatusBar = "Starting..."
End With

' pro mandelbrotovu mnozinu i od -1 do 1, j od -2 do 1
numRows = Int((2 - (-2)) / 0.003) + 1
For i = -2 To 2 Step 0.003
    k = k + 1
    pocitadloi = pocitadloi + 1
    pocitadloj = 0
    For j = -1 To 1 Step 0.003
        pocitadloj = pocitadloj + 1
        If iterateQueen(i, j) = 1 Then Cells(pocitadloi, pocitadloj).Interior.ColorIndex = 3
    Next j
    If k Mod Int(numRows / 100) = 0 Then
        DoEvents  'prevents status bar from freezing during execution
        Application.StatusBar = "Calculating/Outputting... " & Round((k / numRows) * 100, 0) & "%"
    End If
Next i

' Ending application controls
With Application
    .StatusBar = False
    .DisplayStatusBar = oldStatusBar
    .ScreenUpdating = True
End With
'MsgBox Round(Timer - timerStart, 2) & " seconds"
End Sub
Logged

Explore fractals in MS Excel ~ fraqcel.weebly.com
Iariak
Alien
***
Posts: 26



« Reply #16 on: March 22, 2016, 08:40:12 PM »

Hey thanks for that! I thought "dim i, j as double" defines both as double, shows what I know   lips are sealed I've also never used nor heard of status bar, it looks pretty useful.
Logged
simon.snake
Fractal Bachius
*
Posts: 640


Experienced Fractal eXtreme plugin crasher!


simon.fez SimonSideBurns
« Reply #17 on: March 23, 2016, 12:17:58 AM »

Another minor change to the code rotates the fractal the 'right way around' and makes the colours more interesting.

I cannot upload a copy of the resultant image but I hope it is worth it.

Enjoy.

Code:
Sub Grid()
With Range(Cells(1, 1), Cells(1900, 1900))
    .ColumnWidth = 0.08
    .RowHeight = 0.75
    .Interior.Color = 16777215
End With
End Sub
'----------------------------------------------------
Function iterateQueen(ByVal i As Double, j As Double)
Dim ien As Double, jen As Double, ienz As Double, jenz As Double
Dim xmag As Double, ymag As Double
Dim patri As Integer
xmag = i * i
ymag = j * j
ien = i
jen = j
patri = 1
For k = 1 To 1000
    jen = 2 * ien * jen + j
    ien = xmag - ymag + i
    xmag = ien * ien
    ymag = jen * jen
    If xmag + ymag > 4 Then
        patri = k
        Exit For
    End If
Next k
iterateQueen = patri
End Function
'----------------------------------------------------
Sub drawMandelbrot()
Dim pocitadloi As Integer, pocitadloj As Integer
Dim i As Double, j As Double
Dim oldStatusBar As Boolean, k As Integer, numRows As Integer
'Dim timerStart As Single

' Initial application controls
'timerStart = Timer
With Application
    .ScreenUpdating = False
    oldStatusBar = .DisplayStatusBar
    .DisplayStatusBar = True
    .StatusBar = "Starting..."
End With

' pro mandelbrotovu mnozinu i od -1 do 1, j od -2 do 1
numRows = Int((2 - (-2)) / 0.003) + 1
For i = -2 To 2 Step 0.003
    k = k + 1
    pocitadloi = pocitadloi + 1
    pocitadloj = 0
    For j = -1.5 To 1.5 Step 0.003
        pocitadloj = pocitadloj + 1
        Cells(pocitadloj, pocitadloi).Interior.Color = iterateQueen(i, j)
    Next j
    If k Mod Int(numRows / 100) = 0 Then
        DoEvents  'prevents status bar from freezing during execution
        Application.StatusBar = "Calculating/Outputting... " & Round((k / numRows) * 100, 0) & "%"
    End If
Next i

' Ending application controls
With Application
    .StatusBar = False
    .DisplayStatusBar = oldStatusBar
    .ScreenUpdating = True
End With
'MsgBox Round(Timer - timerStart, 2) & " seconds"
End Sub
Logged

To anyone viewing my posts and finding missing/broken links to a website called www.needanother.co.uk, I still own the domain but recently cancelled my server (saving £30/month) so even though the domain address exists, it points nowhere.  I hope to one day sort something out but for now - sorry!
Pages: 1 [2]   Go Down
  Print  
 
Jump to:  

Related Topics
Subject Started by Replies Views Last post
Evil Rabinovich castle Mandelbulb3D Gallery DarkBeam 0 436 Last post February 19, 2011, 01:53:08 PM
by DarkBeam
Evil Pig 2d Art Kali 0 1904 Last post April 22, 2011, 09:26:54 PM
by Kali
Unknown Evil Images Showcase (Rate My Fractal) Kali 1 999 Last post October 21, 2011, 11:45:38 AM
by cKleinhuis
Flock of Evil Images Showcase (Rate My Fractal) Fractal Ken 0 609 Last post November 02, 2011, 08:51:10 AM
by Fractal Ken
Evil Roots Mandelbulb3D Gallery Tahyon 0 448 Last post January 31, 2012, 06:08:42 PM
by Tahyon

Powered by MySQL Powered by PHP Powered by SMF 1.1.21 | SMF © 2015, Simple Machines

Valid XHTML 1.0! Valid CSS! Dilber MC Theme by HarzeM
Page created in 0.149 seconds with 27 queries. (Pretty URLs adds 0.005s, 2q)