Power-Programmierung/CD1.mdf/basic/library/trubasic/chaos/xtent.tru

Text File | 1980-01-01 | 5.6 KB | 189 lines

DECLARE DEF TENT
!PROGRAM "XTENT"
LIBRARY "SGLIB.TRC"
DIM CELL(1000),PROB(1000),G(1),H(1)
CLEAR
PRINT"                COMPREHENSIVE TENT MAP PROGRAM"
PRINT
PRINT"CHOOSE ONE OF THE FOLLOWING OPTIONS FOR THE TENT MAP:"
PRINT" 1)RETURN MAP"
PRINT" 2)BIFURCATION DIAGRAM"
PRINT" 3)ENTROPY DIAGRAM"
PRINT" 4)LYAPUNOV EXPONENT DIAGRAM"
INPUT PROMPT" CHOOSE 1,2,3, OR 4: ":CHOICE
CLEAR
!
CALL LINPUTS(CHOICE,XINT,LAMBDA,INITLAMBDA,FINLAMBDA,STEPLAMBDA,INITNUM,FINNUM,ORDER,NUMCELLS,XMIN,XMAX,YMIN,YMAX,TITLE1$,TITLE2$,VLABEL$,HLABEL$)
!
!GRAPHING SET-UP PROCEDURE
CALL SETXSCALE(XMIN,XMAX)
CALL SETYSCALE(YMIN,YMAX)
CALL SETAXES(0)
CALL SETTEXT(TITLE1$,HLABEL$,VLABEL$)
CALL RESERVELEGEND
DATA 0,0
CALL DATAGRAPH(G,H,0,0,"WHITE")
CALL GOTOCANVAS
!
IF CHOICE=1 THEN CALL CALCULATION1(LAMBDA,XINT,INITNUM,FINNUM,ORDER)
IF CHOICE=2 THEN CALL CALCULATION2(XINT,INITLAMBDA,FINLAMBDA,STEPLAMBDA,INITNUM,FINNUM)
IF CHOICE=3 THEN CALL CALCULATION3(XINT,INITLAMBDA,FINLAMBDA,STEPLAMBDA,INITNUM,FINNUM,NUMCELLS)
IF CHOICE=4 THEN CALL CALCULATION4(XINT,INITLAMBDA,FINLAMBDA,STEPLAMBDA,INITNUM,FINNUM)
!
SUB LINPUTS(CHOICE,XINT,LAMBDA,INITLAMBDA,FINLAMBDA,STEPLAMBDA,INITNUM,FINNUM,ORDER,NUMCELLS,XMIN,XMAX,YMIN,YMAX,TITLE1$,TITLE2$,VLABEL$,HLABEL$)
    INPUT PROMPT"INPUT INITIAL X VALUE:":XINT
    IF CHOICE=1 THEN INPUT PROMPT"INPUT LAMBDA, [0,1]:":LAMBDA
    INPUT PROMPT"INPUT NUMBER OF INITIAL THROWAWAY ITERATIONS:":INITNUM
    INPUT PROMPT"INPUT TOTAL NUMBER OF ITERATIONS:":FINNUM
    IF CHOICE>1 THEN
       INPUT PROMPT"INPUT LOWEST LAMBDA VALUE:":INITLAMBDA
       INPUT PROMPT"INPUT HIGHEST LAMBDA VALUE:":FINLAMBDA
    END IF
    IF CHOICE=1 THEN INPUT PROMPT"INPUT ORDER OF MAP:":ORDER
    IF CHOICE=3 THEN INPUT PROMPT"INPUT # OF CELLS:":NUMCELLS
    IF CHOICE=1 THEN LET ORDER$=STR$(ORDER)
    IF CHOICE=1 THEN
       LET XMIN=0
       LET XMAX=1
       LET YMIN=0
       LET YMAX=1
       LET TITLE1$="TENT MAP"
       LET TITLE2$="X(N+"&ORDER$&")  VERSUS X(N)"
       LET VLABEL$="N+"&ORDER$&"  X VALUE"
       LET HLABEL$="N  X VALUE"
    END IF
    IF CHOICE>1 THEN
       LET XMIN=INITLAMBDA
       LET XMAX=FINLAMBDA
       LET STEPLAMBDA=(XMAX-XMIN)/740
    END IF
    IF CHOICE=2 THEN
       LET YMIN=0
       LET YMAX=1
       LET TITLE1$="TENT MAP BIFURCATION DIAGRAM"
       LET TITLE2$="LAMBDA="&STR$(XMIN)&" TO LAMBDA="&STR$(XMAX)
       LET VLABEL$="X"
       LET HLABEL$="LAMBDA"
    END IF
    IF CHOICE=3 THEN
       LET YMIN=INT(LOG(1/NUMCELLS))
       LET YMAX=1
       LET TITLE1$="TENT MAP ENTROPY"
       LET TITLE2$="LAMBDA="&STR$(INITLAMBDA)&" TO LAMBDA="&STR$(FINLAMBDA)&":   #CELLS="&STR$(NUMCELLS)&":    RANDOM ENTROPY="&STR$(-LOG(NUMCELLS))
       LET VLABEL$="X"
       LET HLABEL$="LAMBDA"
    END IF
    IF CHOICE=4 THEN
       LET YMIN=-3
       LET YMAX=1
       LET TITLE1$="TENT MAP LYAPUNOV EXPONENTS"
       LET TITLE2$="LAMBDA="&STR$(INITLAMBDA)&" TO LAMBDA="&STR$(FINLAMBDA)
       LET VLABEL$="LYAP EXP"
       LET HLABEL$="LAMBDA"
    END IF
END SUB

!
SUB CALCULATION1(LAMBDA,XINT,INITITERATION,ITERATIONNUM,ORDER)
    PLOT LINES: 0,0;1,1           !PLOTS X(N+1)=X(N) LINE
    FOR I=0 TO 1 STEP .001        !PLOTS CURVE OF Y=TENT
        LET J=I
        FOR ORD=1 TO ORDER
            IF J<.5 THEN
               LET Z=2*LAMBDA*J
            ELSE
               LET Z=2*LAMBDA*(1-J)
            END IF
            LET J=Z
        NEXT ORD
        PLOT I,Z
    NEXT I
    LET X=XINT                    !PLOTS RETURN MAP
    LET Y=0
    IF INITITERATION= 0 THEN
       PLOT X,0;
    END IF
    FOR I=1 TO ITERATIONNUM
        LET J=X
        FOR ORD= 1 TO ORDER
            LET Y=TENT(J,LAMBDA)
            LET J=Y
        NEXT ORD
        IF I>=INITITERATION THEN
           PLOT X,Y;
           PLOT Y,Y;
        END IF
        LET X=Y
    NEXT I
END SUB
!
SUB CALCULATION2(XINT,INITLAMBDA,FINLAMBDA,STEPLAMBDA,INITNUM,FINNUM)
    FOR LAMBDA=INITLAMBDA TO FINLAMBDA STEP STEPLAMBDA
        LET X=XINT
        FOR I=1 TO FINNUM
            LET Y=TENT(X,LAMBDA)
            IF I>INITNUM THEN
               PLOT LAMBDA,Y
            END IF
            LET X=Y
        NEXT I
    NEXT LAMBDA
END SUB
!
SUB CALCULATION3(XINT,INITLAMBDA,FINLAMBDA,STEPLAMBDA,INITNUM,FINNUM,NUMCELLS)
    FOR LAMBDA=INITLAMBDA TO FINLAMBDA STEP STEPLAMBDA
        LET ENTROPY=0
        FOR L=1 TO NUMCELLS
            LET CELL(L)=0
        NEXT L
        LET X=XINT
        FOR I=1 TO FINNUM
            LET Y=TENT(X,LAMBDA)
            IF I>INITNUM THEN
               LET L=INT(NUMCELLS*Y)+1
               LET CELL(L)=CELL(L)+1
            END IF
            LET X=Y
        NEXT I
        FOR L=1 TO NUMCELLS
            LET PROB(L)=CELL(L)/(FINNUM-INITNUM)
            IF PROB(L)>0 THEN
               LET ENTROPY=ENTROPY+PROB(L)*LOG(PROB(L))
            END IF
        NEXT L
        PLOT LAMBDA,ENTROPY;
    NEXT LAMBDA
END SUB
!
SUB CALCULATION4(XINT,INITLAMBDA,FINLAMBDA,STEPLAMBDA,INITNUM,FINNUM)
    FOR LAMBDA=INITLAMBDA TO FINLAMBDA STEP STEPLAMBDA
        LET LYAP=0
        LET X=XINT
        FOR I = 1 TO FINNUM
            LET Y=TENT(X,LAMBDA)
            IF I>INITNUM THEN
               LET LYAP=LYAP+LOG(ABS(LAMBDA*2))  !SUM LOG DERIVATIVES
            END IF
            LET X=Y
        NEXT I
        LET LYAP=LYAP/(FINNUM-INITNUM)
        IF LYAP<-3 THEN LET LYAP=-3
        PLOT LAMBDA,LYAP;
    NEXT LAMBDA
END SUB



DEF TENT(X,LAMBDA)
    IF X<.5 THEN
       LET TENT=2*LAMBDA*X
    ELSE
       LET TENT=2*LAMBDA*(1-X)
    END IF
END DEF
CALL ADDLEGEND(TITLE2$,0,1,"WHITE")
CALL DRAWLEGEND
GET KEY VARIABLE
CLEAR
END