XProfan

English

p.specht

it is not always slight, to a empirisch found reference between two sizes a suitable mathematical Formel to find. the following Program helps thereby, a function with possible small deviation from the tatsächlichen Messergebnissen to find - on english is the "Curve fitting". deference, pure demonstration - legal situation ungeprüft!

Compile Mark Separation

Window Title "KURVEN-ANPASSUNG on Meßpunktwolke"
'{ (D) Demoware, 2012-05 Translated from HP-Basic to XProfan by P. woodpecker
' without jegliche Gewähr! Use in alleiniger blame the Anwenders!
' Rechtsvermerk the Presentation:
' copyright  1987
' John H. Mathews
' Dept. of Mathematics
' California State University, Fullerton
' Nonlinear Curve Fitting
' PROGRAM CURVEFIT
'}
'{ MAIN LOOP
AppendMenubar 10,"Welcher Gleichungstyp gives my Messdaten best again?"
Font 2:Randomize:Set("decimals",15)' : Set("numwidth",15)
Var MaxN&=100
Declare X![100],X1![100],Y![100],Y1![100]
Declare ans$,tmp$,n&,k&,CTYPE&,A!,B!,C!,D!,E!,F!,X!
Declare XMEAN!,YMEAN!,SUMX!,SUMXY!,ERRER!,L!,LM!
g115:
p200' call SUBROUTINE GET DATA
g125:
p400' call SUBROUTINE CURVE TYPE
p2000' call SUBROUTINE CHANGE VARIABLES
p3000' call SUBROUTINE LINEAR REGRESSION
p4000' call SUBROUTINE CONSTANTS
p5000' call SUBROUTINE RESULTS
Print "\n WANT TO FIT ANOTHER CURVE TO THIS DATA ? ";
Input ANS$
Case (ANS$ = "Y") Or (ANS$ = "y") Or (ANS$ = "J") Or (ANS$ = "j"): p6000' call SUBROUTINE REFRESH
Case (ANS$ = "Y") Or (ANS$ = "y") Or (ANS$ = "J") Or (ANS$ = "j"): Goto "g125"
Print "\n WANT TO FIT A CURVE FOR SOME NEW DATA? ";
Input ANS$
Case (ANS$ = "Y") Or (ANS$ = "y") Or (ANS$ = "J") Or (ANS$ = "j"): Goto "g115"
Goto "g9999"
'}

Proc p200' SUBROUTINE GET DATA

    CLS Rnd(8^8)
    Print "\n uses becomes The method 'data-Linearisierung'"
    Print " available Formeln:\n"
    Print " (1) Y=A*X+B,   (2) Y=A/X+B,   (3) Y=D/(X+C)       "
    Print " (4) Y=1/(A*X+B), (5) Y=X/(A+B*X), (6) Y=A*Ln(X)+B "
    Print " (7) Y=C*Exp(A*X),  (8) Y=C*X^A,  (9) Y=(A*X+B)^-2 "
    Print " (10) Y=C*X*Exp(-D*X),    (11) Y=L/(1+C*Exp(A*X))  "
    Print "\n ...for n Messpunkte (X1,Y1),(X2,Y2)...(Xn,Yn) "
    Print " Number of Messpunkte:  n = ";
    Input N&
    Case  N&<2:N&=2
    Print

    WhileLoop n&:K&=&Loop

        Print "X(";K&;") = ";
        Input tmp$
        X![K&]=Val(tmp$)
        X1![K&]=X![K&]
        Locate %csrlin-1,%pos+35
        Print "Y(";K&;") = ";
        Input tmp$
        Y![K&]=Val(tmp$)
        Y1![K&]=Y![K&]
        'PRINT

    EndWhile

ENDPROC

Proc p400' SUBROUTINE CURVE_TYPE

    CLS Rnd(8^8)
    Print "      WHICH CURVE DO YOU WANT TO FIT ?\n"
    Print " 1:   Y = A * X + B"
    Print " 2:   Y = A / X + B"
    Print " 3:   Y = D / (X + C)"
    Print " 4:   Y = 1 / (A * X + B)"
    Print " 5:   Y = X / (A + B * X)"
    Print " 6:   Y = A * Ln(X) + B"
    Print " 7:   Y = C * Exp(A * X)"
    Print " 8:   Y = C * X^A"
    Print " 9:   Y = (A * X + B)^-2"
    Print "10:   Y = C * X * EXP(-D * X)"
    Print "11:   Y = L / (1 + C * EXP(A * X) )\n"
    Print "      CHOOSE TYPE OF CURVE [1-11]: ";
    Input CTYPE&

    If  CTYPE& = 11

        Goto "g550"

    Else

        Goto "g645"

    EndIf

    g550:
    CLS
    Print
    Print "     YOU CHOSE THE CURVE  Y = L / (1 + C * EXP(A * X))"
    Print
    Print " THE LIMITING  VALUE  L =  LIM   Y(X)  MUST BE GIVEN."
    Print "                                         X ->INF"
    Print
    Print " ENTER  THE  VALUE    L = ";
    Input L!
    LM!=Abs(Y![1])

    WhileLoop 2,n&:k&=&Loop

        Case LM!<Abs(Y![K&]): LM!=Abs(Y![K&])

    EndWhile

    Case L!<=LM!: L!=LM! * 1.0001
    g645:

ENDPROC

Proc p1000' SUBROUTINE FUNCTIONS

    Select CTYPE&

        CaseOf 1: F!=A!*X!+B! : Goto "g1115"

        CaseOf 2: F!=A!/X!+B! : Goto "g1115"

        CaseOf 3: if (X!+C!)<>0:F!=D!/(X!+C!): Else F!=10^30:endif :Goto "g1115"

        CaseOf 4: F!=1/(A!*X!+B!) : Goto "g1115"

        CaseOf 5: F!=X!/(A!+B!*X!) : Goto "g1115"

        CaseOf 6: F!=A!*LG(X!)+B! : Goto "g1115"

        CaseOf 7: F!=C!*Exp(A!*X!) : Goto "g1115"

        CaseOf 8: F!=C!*Exp(A!*LG(X!)) : Goto "g1115"

        CaseOf 9: F!=1/((A!*X!+B!)*(A!*X!+B!)) : Goto "g1115"

        CaseOf 10: F!=C!*X!*Exp(-D!*X!) : Goto "g1115"

        CaseOf 11: F!=L!/(1+C!*Exp(A!*X!))

    EndSelect

    g1115:

ENDPROC

Proc p2000' SUBROUTINE CHANGE VARIABLES

    WhileLoop n&:k&=&Loop

        Select CTYPE&

            CaseOf 1

            X![K&]=X1![K&]:Y![K&]=Y1![K&] : Goto "g2118"

            CaseOf 2

            X![K&]=1/X1![K&]:Y![K&]=Y1![K&] : Goto "g2118"

            CaseOf 3

            X![K&]=X1![K&]*Y![K&]:Y![K&]=Y1![K&] : Goto "g2118"

            CaseOf 4

            X![K&]=X1![K&]:Y![K&]=1/Y1![K&] : Goto "g2118"

            CaseOf 5

            X![K&]=1/X1![K&]:Y![K&]=1/Y1![K&] : Goto "g2118"

            CaseOf 6

            X![K&]=LG(X1![K&]):Y![K&]=Y1![K&] : Goto "g2118"

            CaseOf 7

            X![K&]=X1![K&]:Y![K&]=LG(Y1![K&]) : Goto "g2118"

            CaseOf 8

            X![K&]=LG(X1![K&]):Y![K&]=LG(Y1![K&]) : Goto "g2118"

            CaseOf 9

            X![K&]=X1![K&]:Y![K&]=1/SQR(Y1![K&]) : Goto "g2118"

            CaseOf 10

            X![K&]=X1![K&]:Y![K&]=LG(Y1![K&]/X1![K&]) : Goto "g2118"

            CaseOf 11

            X![K&]=X1![K&]:Y![K&]=LG(L!/Y1![K&]-1) : Goto "g2118"

        EndSelect

        g2118:

    EndWhile

Endproc

Proc p3000' SUBROUTINE LINEAR REGRESSION

    XMEAN!=0

    WhileLoop n&:k&=&Loop

        XMEAN!=XMEAN!+X![K&]

    EndWhile

    XMEAN!=XMEAN!/n&
    YMEAN!=0

    WhileLoop n&:k&=&Loop

        YMEAN!=YMEAN!+Y![K&]

    EndWhile

    YMEAN!=YMEAN!/N&
    SUMX!=0

    WhileLoop n&:k&=&Loop

        SUMX!=SUMX!+(X![K&]-XMEAN!)*(X![K&]-XMEAN!)

    EndWhile

    SUMXY!=0

    WhileLoop n&:k&=&Loop

        SUMXY!=SUMXY!+(X![K&]-XMEAN!)*(Y![K&]-YMEAN!)

    EndWhile

    A!=SUMXY!/SUMX!
    B!=YMEAN!-A!*XMEAN!

ENDPROC

Proc p4000' SUBROUTINE CONSTANTS

    If  CTYPE& = 3

        Goto "g4020"

    Else

        Goto "g4050"

    EndIf

    g4020:
    C!= -1.0/A! : D!= -B!/A! : Goto "g4210"
    g4050:

    If  CTYPE& = 7

        Goto "g4070"

    Else

        Goto "g4090"

    EndIf

    g4070:
    C!=Exp(B!) : Goto "g4210"
    g4090:

    If  CTYPE& = 8

        Goto "g4110"

    Else

        Goto "g4130"

    Endif

    g4110:
    C!=Exp(B!) : Goto "g4210"
    g4130:

    If  CTYPE& = 10

        Goto "g4150"

    Else

        Goto "g4180"

    EndIf

    g4150:
    C!=Exp(B!):D!= -1*A! : Goto "g4210"
    g4180:

    If  CTYPE& = 11

        Goto "g4200"

    Else

        Goto "g4210"

    EndIf

    g4200:
    C!=Exp(B!)
    g4210:

ENDPROC

Proc p5000' SUBROUTINE RESULTS

    CLS

    Select CTYPE&

        CaseOf 1

        Print "  F(X) = A*X +B"
        Print
        Print "    A  = ",A!
        Print "    B  = ",B!
        Goto "g5120"

        caseof 2

        Print "  F(X) = A/X + B"
        Print
        Print "    A  =",A!
        Print "    B  =",B!
        Goto "g5120"

        caseof 3

        Print "  F(X) = D/(X + C)"
        Print
        Print "    C  =",C!
        Print "    D  =",D!
        Goto "g5120"

        CaseOf 4

        Print "  F(X) = 1/(A*X + B)"
        Print
        Print "    A  =",A!
        Print "    B  =",B!
        Goto "g5120"

        CaseOf 5

        Print "  F(X) = X/(A + B*X)"
        Print
        Print "    A  =",A!
        Print "    B  =",B!
        Goto "g5120"

        CaseOf 6

        Print "  F(X) = A*Ln(X) + B"
        Print
        Print "    A  =",A!
        Print "    B  =",B!
        Goto "g5120"

        CaseOf 7

        Print "  F(X) = C*Exp(A*X)"
        Print
        Print "    A  =",A!
        Print "    C  =",C!
        Goto "g5120"

        CaseOf 8

        Print "  F(X) = C*X^A"
        Print
        Print "    A  =",A!
        Print "    C  =",C!
        Goto "g5120"

        caseof 9

        Print "  F(X) = (A*X + B)^-2"
        Print
        Print "    A  =",A!
        Print "    B  =",B!
        Goto "g5120"

        CaseOf 10

        Print "  F(X) = C*X*EXP(-D*X)"
        Print
        Print "    C  =",C!
        Print "    D  =",D!
        Goto "g5120"

        CaseOf 11

        Print "  F(X) = L/(1+C*EXP(A*X))"
        Print
        Print "    L  =",L!
        Print "    C  =",C!
        Print "    A  =",A!

    EndSelect

    g5120:
    Print
    Print "K            Xk            Yk           F(Xk)       Error  "
    Print "_______________________________________________"

    WhileLoop n&:k&=&Loop

        X! = X1![K&]
        p1000' call SUBROUTINE FUNCTIONS
        ERRER!=Y1![K&] - F!
        Print K&, X1![K&], Y1![K&], F!, ERRER!

    EndWhile

ENDPROC

Proc p6000' SUBROUTINE REFRESH

    WhileLoop  N&:k&=&Loop

        X![K&]=X1![K&]
        Y![K&]=Y1![K&]

    EndWhile

ENDPROC

g9999:
End