Code: Select all
'
' -----------------------------------------------------------------------------
'
' (c) Edward . Q . Montague .
'
' [ alias ]
'
' quintin9g@gmail.com
'
'
' Modified Euler Heun method for Volterra Lottka
' differential equations .
'
' x' = a x - b x y = f1(x,y)
' y' = -g y + c x y = g1(x,y)
'
' In this instance a=b=c=d = 1 , therefore :
'
' u = x - x*y = f1(x,y)
' w = -y + x*y = g1(x,y)
'
' -----------------------------------------------------------------------------
'
'
' Load a 800x600 bitmap into an image
'
' This is from a fractint iteration .
'
' -----------------------------------------------------------------------------
'
declare function f1(x as single,y as single) as single
declare function g1(x as single,y as single) as single
'
declare function store(Byref a1 as single,Byref b1 as single,Byref c1 as single,Byref d1 as single) as integer
'
declare function EH2a(a1() as single,xfinal as single,steps as integer,x as single,y as single) as integer
'
declare function pal() as integer
declare function scanner2(xImage As Any Ptr ,a2() as single) as integer
declare function attractors(a2() as single) as integer
'
' -----------------------------------------------------------------------------
'
#include "EHStr.bas"
'
' -----------------------------------------------------------------------------
'
dim as integer fg
dim as single a2()
'
' -----------------------------------------------------------------------------
'
ScreenRes 820, 690, 8 ' all fractint image files are 8 bit == 256 colours
Dim myImage As Any Ptr = ImageCreate( 800, 600 )
'
BLoad "fract005.bmp", myImage
'
'fg=pal()
'sleep
'end
fg=scanner2(myImage ,a2() )
Put (10,10), myImage
'
window (0,-1)-(128,1)
view (10,612)-(810,688)
'
'
' Function attractor will automatically scan for regions of attraction ,
' from the 'blue' coloured map for the Euler - Huen iterator.
'
'
'fg=attractors(a2() )
fg = mousey()
sleep
ImageDestroy( myImage )
'
end
'
' ==============================
'
function EH2a(a1() as single,xfinal as single,steps as integer,x as single,y as single) as integer
'
'
' Modified Euler Huen method ,
' applied to differential equations defined by f1() and g1() .
'
' This is similar to a fractint frm file .
'
'
static as integer p2,iter
static as single p,h,u,w,a,b,c,d,z
'
'
for iter=0 to steps
a1(iter,0)=0
a1(iter,1)=0
next iter
'
'
p = 0.739
h = 0.739/2
p2 = 256
iter = 0
u = 0
w = 0
a = 0
b = 0
c = 0
d = 0
z = 0
'
while(z<=p2 and (iter<256) )
iter = iter+1
u = f1(x,y)
w = g1(x,y)
a = x+p*u
b = y+p*w
c = x+h*(u+f1(a,b))
d = y+h*(w+g1(a,b))
x = c
y = d
a1(iter-1,0)=x
a1(iter-1,1)=y
' z = x + -flip(y)
z = mag(x,y)
wend
'
return ( iter)
'
'
end function
'
' --------------------------------------------------------------------------------
'
function pal() as integer
'
' Examine palette associated with fractint image .
'
' Choose lower and upper limits for scanner2 function .
'
static as integer i,c
'
line(10,10)-(266,50),0,b
line(10,10)-(266,50),56,b
for i=1 to 255
line(i+10,10)-(i+10,50),i,bf
next i
line(10,10)-(266,50),56,b
'
line(10,70)-(266,110),0,bf
line(10,70)-(266,110),56,b
for i=1 to 255
c = point(i+10,20)
line(i+10,70)-(i+10,110),c,bf
if (c=86) then line(i+10,70)-(i+10,110),12,bf
if (c=114) then line(i+10,70)-(i+10,110),12,bf
next i
line(10,70)-(266,110),56,b
'
return (0)
'
end function
'
' -----------------------------------------------------------------------------
'
function store(Byref a1 as single,Byref b1 as single,Byref c1 as single,Byref d1 as single) as integer
'
' Store coordinates for this fractal
'
'
'
' Top left corner .
'
a1=0
c1=4.5
'
' Bottom right corner .
'
b1=6
d1=0
'
return (0)
'
end function
'
' -----------------------------------------------------------------------------
'
function scanner2(xImage As Any Ptr ,a2() as single) as integer
'
' scan image , in memory , for stable points ; these
' are coloured white when using the blue color map.
'
' Use lower and upper limits selected from function pal().
'
'
' The dimensions of the image are : 800x600 , n x m
'
'
static as integer i,j,n,m,c1,k
static as single ax,bx,cy,dy,x,y
'
i= store(ax ,bx ,cy ,dy )
'
n=800
m=600
'
k = 0
for j=0 to m
for i=0 to n
c1=point(i,j,xImage)
if (c1 > 86) and (c1<114) then k=k+1
next i
next j
'
redim as single a2(k,1)
'
k = 0
for j=0 to m
for i=0 to n
c1=point(i,j,xImage)
if (c1 > 86) and (c1<114) then
a2(k,0)=i
a2(k,1)=j
k=k+1
end if
next i
next j
'
for c1 =0 to k
i=a2(c1,0)
j=a2(c1,1)
x = ax+(bx-ax)*(i)/800
y = cy+(dy-cy)*(j)/600
a2(c1,0) = x
a2(c1,1) = y
next c1
'
return (0)
'
'
end function
'
' --------------------------------------------------------------------------------
'
function attractors(a2() as single) as integer
'
' Waveforms from results of scanner2
'
'
'
static as integer k ,i,fg
static as single a1(256,1),x,y
'
'
k=ubound(a2)
'print"k====";k
for i = 0 to k-1
x = a2(i,0)
y = a2(i,1)
fg = EH2a(a1() , 12 , 256 ,x,y)
fg = plot2d(a1() , 256 )
sleep 500
next i
'
return (k)
'
'
end function
'
' --------------------------------------------------------------------------------
'
function f1(x as single,y as single) as single
'
' x' = x - x*y = f1(x,y)
'
'
static as single z
z = x - x*y
return (z)
end function
'
' -----------------------------------------------------------------------------
'
function g1(x as single,y as single) as single
'
'
' y' = -y + x*y = g1(x,y)
'
'
static as single z
z = -y + x*y
return (z)
end function
'
' ------------------------------------------------------------------------------
'
'
'
'
' Various functions used with the Euler Huen iterator .
'
'
'
Const LEFTBUTTON = 1
Const MIDDLEBUTTON = 4 ' UNUSED IN THIS DEMO
Const RIGHTBUTTON = 2 ' UNUSED IN THIS DEMO
Const SHOWMOUSE = 1
Const HIDEMOUSE = 0
'
declare function mag(x as single,y as single) as single
declare function mousey() as integer
declare function plot2d(a1() as single, steps as integer ) as integer
'declare function scanner2(xImage As Any Ptr ,a2() as single) as integer
'declare function attractors(a2() as single) as integer
'
'declare function pal() as integer
'
declare function transi2x(i as integer,a as single,b as single) as single
declare function transj2y(j as integer,c as single,d as single) as single
'
' =========================================
'
function mousey() as integer
'
' Use mouse to select a point from the fractal .
'
'
'
Dim CurrentX As Integer
Dim CurrentY As Integer
Dim MouseButtons As Integer
Dim CanExit As Integer
Dim as single ax,bx,cy,dy,a1(256,1),x,y
dim as integer fg
'
fg= store(ax , bx ,cy,dy)
'
'
SetMouse 1, 1, SHOWMOUSE
Do
GetMouse CurrentX, CurrentY, , MouseButtons
If MouseButtons And LEFTBUTTON Then
'
If (CurrentX >=10 and CurrentX <=810) and (CurrentY >=10 and CurrentY <= 610 ) then
x = ax+(bx-ax)*(CurrentX-10)/800
y = cy+(dy-cy)*(CurrentY-10)/600
fg = EH2d(a1() , 12 , 256,x,y )
fg = plot2d(a1() , 256 )
End If
'
End If
Loop While Inkey$ = ""
return 0
end function
'
' ------------------------------------------------------------------------------
'
function mag(x as single ,y as single) as single
'
' sqrt(x*x+y*y)
'
static as single w
w=x*x+y*y
if (w>0) then w=sqr(w)
return (w)
'
end function
'
'
' ------------------------------------------------------------------------------
'
function plot2d(a1() as single, steps as integer ) as integer
'
' Plot sequence generated from EH2a()
'
'
'window (0,-1)-(steps,1)
' view (10,612)-(810,688)
static as integer i,j
static as single maxx,maxy,x,y,u,v
line (0,-1)-(steps,1),0,bf
i=2
maxx = 0
maxy = 0
for i=0 to steps
x = a1(i,0)
y = a1(i,1)
x = abs(x)
y= abs(y)
if (x>maxx) then maxx=x
if(y>maxy) then maxy=y
next i
'
if (maxx=0) then maxx=1
if (maxy=0) then maxy=1
'
x = a1(0,0)/maxx
y = a1(0,1)/maxy
j=0
'
for i=1 to steps
u = a1(i,0)/maxx
v = a1(i,1)/maxy
line(j,x)-(i,u), 96
line(j,y)-(i,v), 53
j = i
x = u
y = v
next i
'
return (i)
end function
'
' ------------------------------------------------------------------------------
'
function transi2x(i as integer,a as single,b as single) as single
'
' translate from screen coordinate to map coordinate
'
static as single x
'
x = a+(b-a)*i/800
'
return (x)
'
end function
'
' -----------------------------------------------------------------------------
'
function transj2y(j as integer,c as single,d as single) as single
'
' translate from screen coordinate to map coordinate
'
static as single y
'
y = c+(d-c)*(j)/600
'
return (y)
'
end function
'
Comments: Gated by NETNEWS@AUVM.AMERICAN.EDU
Newsgroups: bit.listserv.frac-l
Via: uk.ac.mdx.vaxa; Mon, 27 Jun 1994 00:09:14 +0100
Message-ID: <FRAC-L%94062619112203@GITVM1.GATECH.EDU>
Date: Mon, 27 Jun 1994 00:10:00 GMT
Sender: "\"FRACTAL\" discussion list" <FRAC-L@GITVM1.BITNET>
From: DAVID1@VAXB.MIDDLESEX.AC.UK
Subject: Ramiro Perez Volterra .FRM
Lines: 33
These are the Volterra-Lotka Formulas p 125 BOF received from Ramiro Perez:
comment={received from Ramiro Perez <RPEREZ@EARN.UTPVM1> 18 Aug 93
}
V-Euler{
x=real(pixel),
y=imag(pixel),
h=real(p1)/2:
u=x-x*y,
w=-y+x*y,
c=x+h*(u+u),
d=y+h*(w+w),
x=c,
y=d,
z=x+flip(y),
|z|<=p2
}
V-Heun{
x=real(pixel),
y=imag(pixel),
p=real(p1),
h=imag(p1)/2:
u=x-x*y,
w=-y+x*y,
a=x+p*u,
b=y+p*w,
c=x+h*(u+(a-a*b)),
d=y+h*(w+(-b+a*b)),
x=c,
y=d,
z=x+flip(y),
|z|<=p2
}
Regards David Walter London england.
VHeun { ; Volterra-Lottka
reset=2004 type=formula formulafile=fractint.frm formulaname=V-Heun
corners=0.000150015/6.00015/0/4.5
params=0.73899999999999999/0.73899999999999999/64/0 float=y
maxiter=2048 inside=bof60 logmap=yes colors=@blues.map
}