STRANGE ATTRACTOR ICON SEARCH (1995 J. C. Sprott )

[SMcNeill]

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