Fast & simple Mandelbrot

Blitz3D Forums/Blitz3D Programming/Fast & simple Mandelbrot

Finjogi (Posted 2006) [#1]

I found this one from KPL (http://www.k-p-l.org/index.php) and converted it to the Blitz3d (some unneeded code is commented out..) It is quite fast I must say.. even if it traces only edges of set. How about little "challenge", could you make this faster or improve it otherwise? (like fillingspace between trace edges..) ;Program MandelbrotTria ; This .kpl program runs in KPL - see <a href="http://www.k-p-l.org" target="_blank">http://www.k-p-l.org</a> ; Triangulate a mandelbrot set, by Michael Hoger ; Idia taken from " Fractals for the Classroom " by Peitgen/jürgens/Saupe. ; This is a different And faster algorithm For approximating And displaying ; a fractal image, compared To a previous KPL example, Mandelbrot.kpl. ; It would be a very interesting exercise of both mathematics And computer ; programming To examine And contrast the two example programs side by side. ; Difficulty level: Advanced (based on the complex math, Not the code) ; Concepts: String manipulation, array abstractions, nested looping, pen drawing ; KPL Lines: 91 ; Author: Michael Hoger ; Blitz3d conversion by FinJogi Graphics 800, 600, 32, 2 Origin 400,300 ; a triangle Dim trix(3) Dim triy(3) ;the verts ;vin=0 ;vout=0 ;vnew=0 ;vtemp=0 ; a coordinate To find the edge of the fractal ;ix=0 ; startcoordinates ;xin=0 ;yout=0 ; a complex number ;real#=0 ;imag#=0 ; two helper ;Outside=False ;Closed=False ; iterationindex k = 0 kend = -50 kstep = 1 scale# = 4.0 / Float( 600 - 30 ) ; start the iteration While k >= kend ; search the edge of the fractal along the x-axis ; For this iteration ix = 0 Outside = False While Not Outside real# = scale# * Float(ix) imag# = 0 Outside = Mandelbrottest( k, real#, imag# ) ix = ix + 1 Wend ; we found the edge now init the First triangle ; a triangle is formed about three points And look ; .................... ; like ..0....0...00...00.. ; ..00..00...0.....0.. ; .................... vin = 1 vout = 2 vnew = 3 trix(vin) = ix - 1 trix(vout) = ix trix(vnew) = ix triy(vin) = 0 triy(vout) = 0 triy(vnew) = 1 ; hold some information To see when we are around xin = trix(vin) yout = triy(vout) ; define the Color And move To First point Color( 100 - ( k * 3 Mod 255 ), 0, 128 ) ;ColorRGB( 100 - ( k * 3 Mod 255 ), 0, 0 ) ;Pen( False ) ;MoveTo( trix [ vin ], triy[ vin ] ) ;Pen( True ) Plot( trix(vin), triy(vin) ) ; Now the tricky part. We follow the funktion at this iteration ; by mirrorring our triangle along the x- And y- axis. ; The mandelbrottest inform us what we have To do Next. Closed = False While Not Closed ; New complex number real# = scale# * Float( trix(vnew) ) imag# = scale# * Float( triy(vnew) ) ; test For outside And mirror triangle If Outside = Mandelbrottest( k, real#, imag# ) Then vtemp = vout vout = vnew vnew = vtemp Else ;MoveTo( trix(vnew), triy(vnew) ) Plot(trix(vnew), triy(vnew)) vtemp = vin vin = vnew vnew = vtemp End If ; calculate the New vertex trix(vnew) = trix(vin) + trix(vout) - trix(vtemp) triy(vnew) = triy(vin) + triy(vout) - triy(vtemp) ; see If we are closed For this iteration If trix(vout) = xin Then If triy(vout) = yout Then Closed = True End If End If Wend kstep = kstep + 2 k = k - kstep Wend WaitKey() End ; this Function tests If an complex number is in Or outside the mandelbrot set ; depend on the number of iteration. Function Mandelbrottest(Iter, real#, imag# ) re# = real# im# = imag# re2#=0 im2#=0 j = 2 While ( j ) >= Iter re2# = re# * re# im2# = im# * im# If ( re2# + im2# ) > 256 Then Return True End If im# = 2 * re# * im# + imag# re# = re2# - im2# + real# j = j - 1 Wend Return False End Function

luke101 (Posted 2006) [#2]

you could probably squeeze some speed out of it by turning some floating point variable to integer. But the code looks pretty optimized

Finjogi (Posted 2006) [#3]

Back in 'good old days' I played with fixed point Mandelbrot code with my Amiga (no float HW).. funny how that code kicked ass of some 5x clocked PC's.. 32bit vs. 16bit registers :)

John Blackledge (Posted 2006) [#4]

This is the one I like (you can zoom in using the mouse): ;Mandelbrot Fractal code, edit by muk on 8/2/06 Screen_Width=800 Screen_Height=600 AppTitle "Mandelbrot Fractal" Graphics Screen_Width,Screen_Height,32,2 SetBuffer BackBuffer() ; ------------------ ; Make palette ; ------------------ ;Px,Py,Tx,Ty,StartRed#,StartGrn#,StartBlu#,EndRed#,EndGrn#,EndBlu#,Dir Procedure_DrawGradientBlock(0,0,255,5,50,0,255,0,0,0,0) Dim col(256) LockBuffer For i=0 To 255 col(i)=ReadPixelFast(i,2)*8 And $FFFFFF ;<- edit: use readpixelfast Next UnlockBuffer .reset ;<- edit: reset zoom maxcolor=255 largeval#=10000 ;<- edit: set largevalue leftside#=-2.0 *largeval# ;<- edit: multiply by largevalue top#=1.2 *largeval# xside#=2.5 *largeval# yside#=-2.5 *largeval# ; ------------ ; Redraw ; ------------ .again Cls ;<- edit: clear screen before redraw xmax#=Screen_Width ymax#=Screen_Height xscale#=xside#/Float(xmax) yscale#=yside#/Float(ymax) For y=0 To ymax-1 LockBuffer For x=0 To xmax-1 cx#=x*xscale#+leftside# cy#=y*yscale#+top# cx#=cx#/Float(largeval) ;<- edit: divide by largevalue cy#=cy#/Float(largeval) zx#=0 zy#=0 colorcounter=0 While zx#*zx#+zy#*zy#<4 And colorcounter<maxcolor tempx#=zx#*zx#-zy#*zy#+cx# zy#=2*zx#*zy#+cy# zx#=tempx# colorcounter=colorcounter+1 Wend WritePixelFast x,y,Col(colorcounter) ;<- edit: use writepixelfast If KeyDown(1) Then End ;<- edit: escape while redrawing Next UnlockBuffer Flip ;<- nb: in fullscreen flip only draws every other line? Text 0,0,"Redrawing, Please Wait..." ;<- edit: text message Next For y=0 To 12 ;<- edit: oops, ok draw over the text message again LockBuffer For x=0 To 200 cx#=x*xscale#+leftside# cy#=y*yscale#+top# cx#=cx#/Float(largeval) ;<- edit: divide by largevalue cy#=cy#/Float(largeval) zx#=0 zy#=0 colorcounter=0 While (zx#*zx#+zy#*zy#<4 And colorcounter<maxcolor) tempx#=zx#*zx#-zy#*zy#+cx# zy#=2*zx#*zy#+cy# zx#=tempx# colorcounter=colorcounter+1 Wend WritePixelFast x,y,Col(colorcounter) Next UnlockBuffer Next ; ---------------------------------------------------- ; Wait for rectangular selection for zoom ; ---------------------------------------------------- mandel=CreateImage(Screen_Width,Screen_Height) ;<- edit: draw full screen CopyRect 0,0,Screen_Width,Screen_Height,0,0,BackBuffer(),ImageBuffer(mandel) SetBuffer BackBuffer() Color 255,255,255 mousepress=False selection=False MouseHit(1) MouseHit(2) Repeat Cls ;<- edit: to clear rect in fullscreen DrawImage mandel,0,0 Color 255,255,255 Plot MouseX(),MouseY() ;<- edit: show mouse position in fullscreen Text 0,0,xside+"-"+yside If Not mousepress If MouseHit(1) sx=MouseX() sy=MouseY() mousepress=True End If If MouseHit(2) ;<- edit: reset on rightclick selection=2 End If If KeyDown(1) Then End ;<- edit: escape Else If MouseDown(1) ex=MouseX() ey=sy+(ex-sx)*3/4 ;<- edit: true screen rect box, instead of MouseY() If sx>ex startx=ex endx=sx Else startx=sx endx=ex End If If sy>ey starty=ey endy=sy Else starty=sy endy=ey End If Rect startx,starty,endx-startx,endy-starty,False Else LockBuffer ;<- edit: prevent redraw if selected pixels all same color startcolor=ReadPixelFast(startx,starty) And $FFFFFF For iy=starty To endy For ix=startx To endx currcolor=ReadPixelFast(ix,iy) And $FFFFFF If currcolor<>startcolor selection=True Exit End If Next Next UnlockBuffer If Not selection Then mousepress=False End If End If Flip Until selection FreeImage mandel newxside#=xside#*Float((endx-startx)/Float(xmax)) newyside#=yside#*Float((endy-starty)/Float(ymax)) newleftside#=leftside#+(xside#*Float(startx/Float(xmax))) newtop#=top#+(yside#*Float(starty/Float(ymax))) leftside#=newleftside top#=newtop xside#=newxside yside#=newyside Cls ;<- edit: to clear in fullscreen Flip If selection=2 Goto reset Else Goto again End If ; ---------------------------- ; Draw Gradient block ; ---------------------------- Function Procedure_DrawGradientBlock(Px,Py,Tx,Ty,StartRed#,StartGreen#,StartBlue#,EndRed#,EndGreen#,EndBlue#,Dir=0) If Dir=0 Direction=Tx Temp_X=Px Temp_Y=Tx Else Direction=Ty Temp_X=Py Temp_Y=Ty EndIf GradientRed#=(EndRed-StartRed)/Direction GradientGreen#=(EndGreen-StartGreen)/Direction GradientBlue#=(EndBlue-StartBlue)/Direction For Grad=Temp_X To Temp_X+Temp_Y Color StartRed,StartGreen,StartBlue If Dir=0 Line Grad,Py,Grad,Py+Ty Else Line Px,Grad,Px+Tx,Grad EndIf StartRed=StartRed+GradientRed StartGreen=StartGreen+GradientGreen StartBlue=StartBlue+GradientBlue Next End Function Or if you want a really simple one Graphics 800,600,16,2 SetBuffer BackBuffer() maxcolor=255 leftside#=-2 : top#=1.25 xside#=2.5 : yside#=-2.5 xmax=800 : ymax=680 xscale# = xside# / xmax yscale# = yside# / ymax For y=1 To ymax For x=1 To xmax cx# = x * xscale# + leftside# cy# = y * yscale# + top# zx# = 0 zy# = 0 colorcounter = 0 max = 5 ; 4 While (zx# * zx# + zy# * zy# < max And colorcounter < maxcolor) tempx# = zx# * zx# - zy# * zy# + cx# zy# = 2 * zx# * zy# + cy# zx# = tempx# colorcounter=colorcounter+1 Wend Dot(x,y,colorcounter) Next Flip Next WaitKey End Function Dot(x,y,colorcounter) offset = 0 r = offset + (colorcounter * 8) g = offset + (colorcounter * 4) b = offset + (colorcounter * 1) Color r,g,b Plot x,y End Function

Finjogi (Posted 2006) [#5]

While ago I messed with the upper one and found little optimazation :) Flip -> Flip False :) Huge boost in small zoom levels.

bytecode77 (Posted 2006) [#6]

WritePixelFast are better solutions i guess :) and if you put flip 0 on the END of the program, he doesnt flip 800x600 times the backbuffer ;) Graphics 800,600,16,2 SetBuffer BackBuffer() maxcolor=255 leftside#=-2 : top#=1.25 xside#=2.5 : yside#=-2.5 xmax=800 : ymax=600 xscale# = xside# / xmax yscale# = yside# / ymax AppTitle "please wait..." LockBuffer For y=0 To ymax - 1 For x=0 To xmax - 1 cx# = x * xscale# + leftside# cy# = y * yscale# + top# zx# = 0 zy# = 0 colorcounter = 0 max = 5 ; 4 While (zx# * zx# + zy# * zy# < max And colorcounter < maxcolor) tempx# = zx# * zx# - zy# * zy# + cx# zy# = 2 * zx# * zy# + cy# zx# = tempx# colorcounter=colorcounter+1 Wend r = colorcounter * 8 g = colorcounter * 4 b = colorcounter * 1 WritePixelFast x, y, r*$10000 + g*$100 + b, GraphicsBuffer() Next Next UnlockBuffer Flip WaitKey End cu