Mandelbrot Orbits

[dcromley]

The Mandelbrot set is another example of mathematical chaos and there is much enjoyment to be had by examining it.  From wikipedia:
"The Mandelbrot set is the set of complex numbers c for which the function z=z^2+c does not diverge to infinity when iterated from z=0."

There are many programs which show the set and zoom into the set and there is an infinity of patterns and much similarity. 

This program shows the orbit (iterations) of the function for one mouse-selected number c.  For a number in the set, the function can slowly or rapidly  converge to one number, or it can oscillate/rotate among many numbers.  For numbers not in the set, the function can slowly or rapidly go off to infinity.  The numbers near the edge of the set make the most complex patterns.

I originally wrote this program (VMBROT.exe) around 1994; somebody used it in their doctoral thesis: https://www.academia.edu/18072755/Fracta...chitecture (no pictures in pdf?)

Code: (Select All)

_Title "Mandelbrot Orbits" ' dcromley
Option _Explicit
DefLng I
Screen _NewImage(1024, 768, 256)

Const xlo = -2.4, xhi = .8, ylo = -1.2, yhi = 1.2
Dim Shared imx, imy, imDn, imClk, imEnd, iImgSave
Dim mx, my

doCreate ' create the image
iImgSave = _CopyImage(0) ' save
Do ' wait for mouse input
  _Limit 30
  MouseCk
  uv2xy imx, imy, mx, my
  Color 15, 8
  Locate 2, 3: Print "mx,my:  ";: Print Using "##.##,##.##"; mx; my
  Locate , 3: Print "Black:  Mandelbrot set (remains local)"
  Locate , 3: Print "Gray:   Not Mandelbrot (goes to infinity)"
  Locate , 3: Print "Yellow: Not Mandelbrot (almost remains local)"
  Locate , 3: Print "Press left button to get orbit"
  Locate , 3: Print "ESC to exit"
  If imClk Then doOrbit ' upon Click, show orbit
  If InKey$ = Chr$(27) Then System
Loop

Sub doCreate () ' draw mandelbrot set
  Dim i, iu, iv, x0, y0, x, y, xx, yy, ic
  For iv = 0 To 766 ' screen horiz
    For iu = 0 To 1023 ' screen vert
      uv2xy iu, iv, x0, y0 ' get x0,y0
      x = 0: y = 0 ' start at 0, 0
      For i = 0 To 1000 ' 1000 max iterations
        xx = x * x - y * y + x0 ' (x, y) squared + (x0, y0)
        yy = 2 * x * y + y0
        If xx * xx + yy * yy > 4 Then Exit For ' not in set
        x = xx: y = yy ' for next iteration
      Next i
      ic = 8 ' not in set
      If i > 20 Then ic = 14 ' yellow, almost in set
      If i = 1001 Then ic = 0 ' black, in set
      PSet (iu, iv), ic
    Next iu
  Next iv
End Sub

Sub doOrbit () ' show orbit
  Dim i, x0, y0, x, y, xx, yy, iu, iv
  PSet (imx, imy), 15 ' orbit start
  uv2xy imx, imy, x0, y0 ' get x0,y0
  x = 0: y = 0 ' start at 0, 0
  For i = 0 To 1000 ' 1000 max iterations
    _Limit 30
    MouseCk
    If imEnd Then GoTo zreset
    xx = x * x - y * y + x0 ' (x, y) squared + (x0, y0)
    yy = 2 * x * y + y0
    xy2uv xx, yy, iu, iv
    Line -(iu, iv), 15
    If xx * xx + yy * yy > 50 Then Exit For ' not in set
    x = xx: y = yy ' for next iteration
  Next i
  Do: _Limit 30: MouseCk: Loop Until imEnd
  zreset:
  _PutImage , iImgSave, 0 ' reset
End Sub

Sub uv2xy (iu, iv, x, y) ' screen u, v to world x, y
  x = lerplh(xlo, xhi, iu, 0, 1023)
  y = lerplh(ylo, yhi, iv, 766, 0)
End Sub

Sub xy2uv (x, y, iu, iv) ' world x, y to screen u, v
  iu = lerplh(0, 1023, x, xlo, xhi)
  iv = lerplh(766, 0, y, ylo, yhi)
End Sub

Function lerplh (xlo, xhi, y, ylo, yhi) ' linear interpolation
  Dim k01: k01 = (y - ylo) / (yhi - ylo) ' get k01
  lerplh = xlo * (1 - k01) + xhi * k01
End Function

Sub MouseCk () ' Mouse routine
  Static imPrev ' previous time Down?
  imClk = 0: imEnd = 0 ' down, up edges
  Do While _MouseInput: Loop ' clear
  imx = _MouseX: imy = _MouseY: imDn = _MouseButton(1) ' now
  If imDn Then
    If Not imPrev Then imClk = -1 ' down edge
  Else
    If imPrev Then imEnd = -1 ' up edge
  End If
  imPrev = imDn ' for next time
End Sub

[SierraKen]

That's pretty wild! I've always wondered if someone could make this in BASIC. Good job!

[RhoSigma]

That's pretty wild! I've always wondered if someone could make this in BASIC. Good job!

Try out the Fractal screen saver.

[bplus]

Thumbs up, interesting perspective on Mandelbrot. At Bp.org and Retro someone was doing something Mandelbrot every other week but no one did this. They were either exploring or using it for Timed tests.

[SierraKen]

That's pretty wild! I've always wondered if someone could make this in BASIC. Good job!

Try out the Fractal screen saver.

Rho that was incredible! Hey did you used to go to the newsgroup comp.lang.basic.misc back in the 90's? I went there to learn the difference between 80's BASIC languages and QBasic. But I seem to recall your Rho logo in the code.