Logistic Equation Bifurcation Diagram

This code has been declared by its author to be Public Domain code.

Logistic Equation Bifurcation Diagram by markcw (Posted 21 years ago)
This is a diagram for what is called the logistic equation. It is a formula for population growth. I added a zoom tool so you can see in nice and close. Not exactly very exciting stuff but I found it fun anyway. edit: speeded this up today. now when you zoom in it is very fast! edit: finally figured out how to speed up drawing this. it's about as fast as it can get now.
;Logistic Equation Bifurcation Diagram, on 16/2/06 ;From C source code by Frizzi, University of Milan ;Adapted from Mandelbrot Fractal code, by filax & fredborg ;The standard logistic equation is: f(x) = R x (1 - x) ;do: Init window=2 ;window mode resmode=0 ;resolution If resmode=0 width=640 height=480 Else width=800 height=600 EndIf AppTitle "Logistic Equation Bifurcation Diagram" Graphics width,height,16,window SetBuffer BackBuffer() ;do: Set Palette cmax = 24 Dim col(cmax) DrawGradientLine(cmax-1,0,200,200,0,0,0) ;colour ;DrawGradientLine(cmax-1,200,200,200,0,0,0) ;grey LockBuffer For i=0 To cmax-1 ;col(i)=ReadPixelFast(i,1) * 8 And $FFFFFF ;colour col(i)=ReadPixelFast(i,1) And $FFFFFF ;grey Next UnlockBuffer iterx = 500 ;set iterances to filter attractor itery = 500 ;set iterances for every wrap to attractor (y density) fixr# = 2.9 ;set population growth rate (r), range is 1-4 ;do: Draw Fractal .reset dxy# = height / Abs(fixr-4) ;xy scale dcx# = 0 ;x axis dcy# = dxy * fixr ;y axis scale# = 1 ;zoom lastx# = 0 lasty# = 0 .redraw r# = fixr r# = r + (4-fixr) * Float(lasty-1) / Float(height) x# = 0.4 rinc# = 1/fixr/scale/itery If rinc<0.0000002 Then rinc=0.0000002 ;limit min, 2.-e7 n = 0 px = 0 py = 0 ClsColor 255,255,255 Cls Text 0,0,"scale="+Int(scale) While r<=4 ;max growth rate LockBuffer For j=1 To 16 ;speed up rate For i=1 To iterx-1 ;filter attractor x# = x * r * (1-x) Next n = n + 1 For i=1 To itery-1 ;wrap attractor x# = x * r * (1-x) colour = (n Mod 15) + 1 ;colour 1-15 n = n + 1 px = dxy * x - dcx py = dxy * r - dcy If px>=0 And px<width And py>=0 And py<height WritePixelFast px,py,col(colour) EndIf If KeyDown(1) Then End ;Esc key Next If py<-20 ;speed up rate r# = r + 1/fixr/scale/10 Else r# = r + rinc EndIf For i=1 To 8 ;speed up rate If py+height/4<-scale/Float(ii) r# = r + 1 / scale / Float(ii) EndIf Next Next UnlockBuffer If window<2 Then Flip ;two flips in fullscreen Flip If py>height-1 Then Exit ;stop drawing Wend image=CreateImage(width,height) CopyRect 0,0,width,height,0,0,BackBuffer(),ImageBuffer(image) SetBuffer BackBuffer() ;do: Main Loop While Not KeyDown(1) Cls ;clear rect in fullscreen DrawImage image,0,0 Color 0,0,0 Plot MouseX(),MouseY() ;show mouse x/y in fullscreen Text 112,0,MouseX()+"-"+MouseY() If mousepress=0 If MouseDown(1) mousepress=1 sx=MouseX() ;start rect x/y sy=MouseY() EndIf If MouseDown(2) Cls ;clear in fullscreen Flip mousepress=0 Goto reset EndIf Else If MouseDown(1) ;do: Draw Rect ex=MouseX() ;end rect x/y ey=MouseY() mx=MouseX() ;set mouse x/y my=MouseY() If sx>mx And sy>my ;upleft, recalculate true screen rect If sx-mx>sy-my ey=sy-(sx-mx)3/4 ;x> Else ex=sx-(sy-my)4/3 ;y> EndIf EndIf If sx<=mx And sy>my ;upright If mx-sx>sy-my ;x> ey=sy+(sx-mx)3/4 Else ex=sx+(sy-my)4/3 ;y> EndIf EndIf If sx>mx And sy<=my ;downleft If sx-mx>my-sy ey=sy+(sx-mx)3/4 ;x> Else ex=sx+(sy-my)4/3 ;y> EndIf EndIf If sx<=mx And sy<=my ;downright If mx-sx>my-sy ey=sy-(sx-mx)3/4 ;x> Else ex=sx-(sy-my)4/3 ;y> EndIf EndIf startx=sx starty=sy endx=Abs(ex-sx) ;set rect width/height endy=Abs(ey-sy) If ex<sx Then startx=ex ;set inverse rect x/y If ey<sy Then starty=ey Rect startx,starty,endx,endy,False Else ;do: New Fractal mousepress=0 If Abs(sx-ex)>4 And Abs(sy-ey)>3 ;set minimum selection area lastx# = lastx + startx / scale lasty# = lasty + starty / scale scale# = scale * Float(height) / Float(endy) newdxy# = dxy * Float(height) / Float(endy) dxy# = newdxy newdcx# = lastx * scale newdcy# = dxy * fixr + lasty * scale dcx# = newdcx dcy# = newdcy Cls ;clear in fullscreen Flip Goto redraw EndIf EndIf EndIf Flip Wend End ;do: Functions Function DrawGradientLine(Nclr,Sred#,Sgreen#,Sblue#,Ered#,Egreen#,Eblue#) Gred#=Ered-Sred/Nclr Ggreen#=Egreen-Sgreen/Nclr Gblue#=Eblue-Sblue/Nclr For g=0 To Nclr Color Sred,Sgreen,Sblue Line g,0,g,5 Sred#=Sred+Gred Sgreen#=Sgreen+Ggreen Sblue#=Sblue+Gblue Next End Function

Logistic Equation Bifurcation Diagram by markcw

(Posted 21 years ago)

This is a diagram for what is called the logistic equation. It is a formula for population growth. I added a zoom tool so you can see in nice and close.

Not exactly very exciting stuff but I found it fun anyway.

edit: speeded this up today. now when you zoom in it is very fast!

edit: finally figured out how to speed up drawing this. it's about as fast as it can get now.

;Logistic Equation Bifurcation Diagram, on 16/2/06
;From C source code by Frizzi, University of Milan
;Adapted from Mandelbrot Fractal code, by filax & fredborg
;The standard logistic equation is: f(x) = R x (1 - x)

;do: Init

window=2 ;window mode
resmode=0 ;resolution

If resmode=0
 width=640
 height=480
Else
 width=800
 height=600
EndIf

AppTitle "Logistic Equation Bifurcation Diagram"
Graphics width,height,16,window
SetBuffer BackBuffer()

;do: Set Palette

cmax = 24
Dim col(cmax)

DrawGradientLine(cmax-1,0,200,200,0,0,0) ;colour
;DrawGradientLine(cmax-1,200,200,200,0,0,0) ;grey

LockBuffer
For i=0 To cmax-1
 ;col(i)=ReadPixelFast(i,1) * 8 And $FFFFFF ;colour
 col(i)=ReadPixelFast(i,1) And $FFFFFF ;grey
Next
UnlockBuffer

iterx = 500 ;set iterances to filter attractor
itery = 500 ;set iterances for every wrap to attractor (y density)
fixr# = 2.9 ;set population growth rate (r), range is 1-4

;do: Draw Fractal

.reset

dxy# = height / Abs(fixr-4) ;xy scale
dcx# = 0 ;x axis
dcy# = dxy * fixr ;y axis
scale# = 1 ;zoom
lastx# = 0
lasty# = 0

.redraw

r# = fixr
r# = r + (4-fixr) * Float(lasty-1) / Float(height)
x# = 0.4
rinc# = 1/fixr/scale/itery
If rinc<0.0000002 Then rinc=0.0000002 ;limit min, 2.-e7
n = 0
px = 0
py = 0

ClsColor 255,255,255
Cls
Text 0,0,"scale="+Int(scale)

While r<=4 ;max growth rate
 LockBuffer
 For j=1 To 16 ;speed up rate
  For i=1 To iterx-1 ;filter attractor
   x# = x * r * (1-x)
  Next
  n = n + 1
  For i=1 To itery-1 ;wrap attractor
   x# = x * r * (1-x)
   colour = (n Mod 15) + 1 ;colour 1-15
   n = n + 1
   px = dxy * x - dcx
   py = dxy * r - dcy
   If px>=0 And px<width And py>=0 And py<height
    WritePixelFast px,py,col(colour)
   EndIf
   If KeyDown(1) Then End ;Esc key
  Next
  If py<-20 ;speed up rate
   r# = r + 1/fixr/scale/10
  Else
   r# = r + rinc
  EndIf
  For i=1 To 8 ;speed up rate
   If py+height/4<-scale/Float(i*i)
    r# = r + 1 / scale / Float(i*i)
   EndIf
  Next
 Next
 UnlockBuffer
 If window<2 Then Flip ;two flips in fullscreen
 Flip
 If py>height-1 Then Exit ;stop drawing
Wend

image=CreateImage(width,height)
CopyRect 0,0,width,height,0,0,BackBuffer(),ImageBuffer(image)
SetBuffer BackBuffer()

;do: Main Loop

While Not KeyDown(1)
 Cls ;clear rect in fullscreen
 DrawImage image,0,0
 Color 0,0,0
 Plot MouseX(),MouseY() ;show mouse x/y in fullscreen
 Text 112,0,MouseX()+"-"+MouseY()

 If mousepress=0

  If MouseDown(1)
   mousepress=1
   sx=MouseX() ;start rect x/y
   sy=MouseY()
  EndIf

  If MouseDown(2)
   Cls ;clear in fullscreen
   Flip
   mousepress=0
   Goto reset
  EndIf

 Else

  If MouseDown(1)

   ;do: Draw Rect

   ex=MouseX() ;end rect x/y
   ey=MouseY()
   mx=MouseX() ;set mouse x/y
   my=MouseY()

   If sx>mx And sy>my ;upleft, recalculate true screen rect
    If sx-mx>sy-my
     ey=sy-(sx-mx)*3/4 ;x>
    Else
     ex=sx-(sy-my)*4/3 ;y>
    EndIf
   EndIf
   If sx<=mx And sy>my ;upright
    If mx-sx>sy-my ;x>
     ey=sy+(sx-mx)*3/4
    Else
     ex=sx+(sy-my)*4/3 ;y>
    EndIf
   EndIf
   If sx>mx And sy<=my ;downleft
    If sx-mx>my-sy
     ey=sy+(sx-mx)*3/4 ;x>
    Else
     ex=sx+(sy-my)*4/3 ;y>
    EndIf
   EndIf
   If sx<=mx And sy<=my ;downright
    If mx-sx>my-sy
     ey=sy-(sx-mx)*3/4 ;x>
    Else
     ex=sx-(sy-my)*4/3 ;y>
    EndIf
   EndIf

   startx=sx
   starty=sy
   endx=Abs(ex-sx) ;set rect width/height
   endy=Abs(ey-sy)
   If ex<sx Then startx=ex ;set inverse rect x/y
   If ey<sy Then starty=ey

   Rect startx,starty,endx,endy,False

  Else

   ;do: New Fractal

   mousepress=0

   If Abs(sx-ex)>4 And Abs(sy-ey)>3 ;set minimum selection area
    lastx# = lastx + startx / scale
    lasty# = lasty + starty / scale
    scale# = scale * Float(height) / Float(endy)
    newdxy# = dxy * Float(height) / Float(endy)
    dxy# = newdxy
    newdcx# = lastx * scale
    newdcy# = dxy * fixr + lasty * scale
    dcx# = newdcx
    dcy# = newdcy
    Cls ;clear in fullscreen
    Flip
    Goto redraw
   EndIf

  EndIf

 EndIf

 Flip
Wend
End

;do: Functions

Function DrawGradientLine(Nclr,Sred#,Sgreen#,Sblue#,Ered#,Egreen#,Eblue#)

Gred#=Ered-Sred/Nclr
Ggreen#=Egreen-Sgreen/Nclr
Gblue#=Eblue-Sblue/Nclr

For g=0 To Nclr
 Color Sred,Sgreen,Sblue
 Line g,0,g,5
 Sred#=Sred+Gred
 Sgreen#=Sgreen+Ggreen
 Sblue#=Sblue+Gblue
Next

End Function