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

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