11-16-2023, 06:35 PM
Code: (Select All)
Rem STRANGE ATTRACTOR ICON SEARCH (c) 1995 by J. C. Sprott
Rem Run under QBASIC, QuickBASIC, or VB/DOS
DefDbl A-Z 'Use double precision
Dim A(12), PAL&(255)
NMAX = 61000 'Maximum number of iterations
TWOPI = 8 * Atn(1) 'A useful constant (2 pi)
Randomize Timer 'Reseed random number generator
Screen 13 'Set graphics mode
SW% = 320 'Screen width
SH% = 200 'Screen height
NC% = 254 'Number of colors
While T% = 0
GoSub Init 'Initialize
While T% = 1
GoSub Iteqn 'Iterate equations
GoSub Display 'Display results
GoSub Test 'Test results
Wend
Wend
Palette: Cls
End
Init: 'Initialize
X = .05: Y = .05: Z = .05 'Initial condition
XE = X + .000001: YE = Y: ZE = Z
T% = 1: LSUM = 0: N = 0: NL = 0
XL = 1000000!: XH = -XL: YL = XL: YH = XH: ZL = XL: ZH = XH
NS% = 2 + Int(8 * Rnd) 'Number of sectors (2 to 9)
OF = .5 + 1.5 * Rnd 'Overlap factor (.5 to 2)
For I% = 1 To 12 'Get random coefficients
A(I%) = (Int(25 * Rnd) - 12) / 10
Next I%
Return
Iteqn: 'Iterate equations
XNEW = A(1) + X * (A(2) + A(3) * X + A(4) * Y) + Y * (A(5) + A(6) * Y)
YNEW = A(7) + X * (A(8) + A(9) * X + A(10) * Y) + Y * (A(11) + A(12) * Y)
ZNEW = X * X + Y * Y
N = N + 1
Return
Display: 'Display results
If N > 100 And N < 1000 Then 'Get scale limits for graph
If X < XL Then XL = X Else If X > XH Then XH = X
If Y < YL Then YL = Y Else If Y > YH Then YH = Y
If Z < ZL Then ZL = Z Else If Z > ZH Then ZH = Z
End If
If N = 1000 Then 'Set palette and clear screen
RANB = Rnd: CB% = 1 + Int(3 * Rnd) 'Blue phase and period
RANG = Rnd: CG% = 1 + Int(3 * Rnd) 'Green phase and period
RANR = Rnd: CR% = 1 + Int(3 * Rnd) 'Red phase and period
BC% = Int(2 + NC% * Rnd) 'Choose random background color
For I% = 2 To NC% + 1 'Redefine palette colors
B% = Int(32 + 32 * Sin(CB% * TWOPI * (I% / NC% + RANB)))
G% = Int(32 + 32 * Sin(CG% * TWOPI * (I% / NC% + RANG)))
R% = Int(32 + 32 * Sin(CR% * TWOPI * (I% / NC% + RANR)))
PAL&(I%) = 65536 * B% + 256 * G% + R%
If I% = BC% Then 'Set background and shadow colors
PAL&(0) = 65536 * Int(B% / 2) + 256 * Int(G% / 2) + Int(R% / 2)
PAL&(1) = 65536 * Int(B% / 3) + 256 * Int(G% / 3) + Int(R% / 3)
End If
Next I%
Cls: Palette Using PAL&(0)
XZ = .05 * SW% / (ZH - ZL)
YZ = .05 * SH% / (ZH - ZL)
End If
If N > 1000 Then 'Plot point on screen
If XH > XL Then XP = SW% * (X - XL) / (XH - XL)
If YH > YL Then YP = SH% * (YH - Y) / (YH - YL)
S% = Int(NS% * Rnd) 'Choose sector randomly
TH = TWOPI * (OF * YP / SH% + S%) / NS%
If (NS% Mod 2) = 0 And (S% Mod 2) = 0 Then TH = TWOPI / NS% - TH
YP = .5 * SH% * (1 + XP * Cos(TH) / SW%)
XP = .5 * SW% * (1 + XP * Sin(TH) / SW%)
C% = 2 + Int(NC% * (Z - ZL) / (ZH - ZL) + NC%) Mod NC%
If C% > Point(XP, YP) Then PSet (XP, YP), C%
XP = XP + XZ * (Z - ZL): YP = YP + YZ * (Z - ZL)
If Point(XP, YP) = 0 Then PSet (XP, YP), 1
End If
Return
Test: 'Test results
If Abs(XNEW) + Abs(YNEW) + Abs(ZNEW) > 1000000! Then T% = 0 'Unbounded
XSAVE = XNEW: YSAVE = YNEW: ZSAVE = ZNEW
X = XE: Y = YE: Z = ZE: N = N - 1
GoSub Iteqn 'Reiterate equations
DLX = XNEW - XSAVE: DLY = YNEW - YSAVE: DLZ = ZNEW - ZSAVE
DL2 = DLX * DLX + DLY * DLY + DLZ * DLZ
If CSng(DL2) > 0 Then 'Don't divide by zero
DF = 1000000000000# * DL2
RS = 1 / Sqr(DF)
XE = XSAVE + RS * (XNEW - XSAVE): XNEW = XSAVE
YE = YSAVE + RS * (YNEW - YSAVE): YNEW = YSAVE
ZE = ZSAVE + RS * (ZNEW - ZSAVE): ZNEW = ZSAVE
LSUM = LSUM + Log(DF): NL = NL + 1
L = .721347 * LSUM / NL 'This is the Lyapunov exponent
End If
If N > 100 And L < .005 Then T% = 0 'Not chaotic
If N > NMAX Then T% = 0 'Strange attractor found
If Len(InKey$) Then T% = 2 'Exit on keypress
X = XNEW: Y = YNEW: Z = ZNEW 'Update value of variables
Return
