Entry
Language: Computer: BBCBASIC: Math: Matrix: 3x3: Eigenvector: How to get the eigenvectors?
Jan 22nd, 2006 18:04
Knud van Eeden,
----------------------------------------------------------------------
--- Knud van Eeden --- 22 January 2006 - 09:43 pm --------------------
Language: Computer: BBCBASIC: Math: Matrix: 3x3: Eigenvector: How to
get the eigenvectors?
---
Steps: Overview:
1. -Create e.g. the following program
--- cut here: begin --------------------------------------------------
REM --- MAIN --- REM
printB% = TRUE
dimB% = TRUE
a11 = 1
a12 = 2
a13 = 3
a21 = 4
a22 = 5
a23 = 6
a31 = 7
a32 = 8
a33 = 9
PRINT FNStringGetPhysicsCalculateEigenvectorGivenMatrix3DS( a11, a12,
a13, a21, a22, a23, a31, a32, a33, dimB%, printB% )
END
:
:
:
REM --- LIBRARY --- REM
:
REM library: string: get: physics: calculate: eigenvector: given:
matrix3 [kn, ri, su, 22-01-2006 21:43:22]
DEF FNStringGetPhysicsCalculateEigenvectorGivenMatrix3DS( a11, a12,
a13, a21, a22, a23, a31, a32, a33, dimB%, printB% )
REM e.g. printB% = TRUE
REM e.g. dimB% = TRUE
REM e.g. a11 = 1
REM e.g. a12 = 2
REM e.g. a13 = 3
REM e.g. a21 = 4
REM e.g. a22 = 5
REM e.g. a23 = 6
REM e.g. a31 = 7
REM e.g. a32 = 8
REM e.g. a33 = 9
REM e.g. PRINT FNStringGetPhysicsCalculateEigenvectorGivenMatrix3DS(
a11, a12, a13, a21, a22, a23, a31, a32, a33, dimB%, printB% )
REM e.g. END
REM e.g. :
REM e.g. :
REM e.g. :
REM
REM
REM ---
REM
REM Running this example shows
REM
REM [ 1 2 3 ]
REM [ ]
REM A = [ 4 5 6 ]
REM [ ]
REM [ 7 8 9 ]
REM
REM
REM ( 1 ) . x^3 + ( -15 ) . x^2 + ( -18 ) . x + ( 0 ) = 0
REM
REM solution: 3 roots:
REM
REM 3 real unequal roots
REM
REM real1 = -1.11684397
REM imag1 = 0
REM real2 = 16.116844
REM imag2 = 0
REM real3 = 0
REM imag3 = 0
REM
REM
REM result of filling in root1 in given equation gives: 8.94069672E-8
REM
REM result of filling in root2 in given equation gives: 8.34465027E-7
REM
REM result of filling in root3 in given equation gives: 0
REM
REM -----------------------------
REM
REM normalized eigenvector1 = 0.785830239 8.67513391E-2 -0.61232756
REM
REM normalized eigenvector2 = 0.231970691 0.525322093 0.818673499
REM
REM normalized eigenvector3 = 0.408248291 -0.816496581 0.408248291
REM
REM -----------------------------
REM
REM The resulting eigenvectors are stored in a string in the format
REM
REM eigenvector1x eigenvector1y eigenvector1z eigenvector2x
eigenvector2y eigenvector2z eigenvector3x eigenvector3y eigenvector3z
REM
REM which is then returned from the function
REM you can then use some string extract function
REM (searching e.g. for the space separator)
REM to get the individual roots out of that string
REM
REM -----------------------------
REM
REM The 3 eigenvectors are
REM
REM 1 0.110394504 -0.779210992 1 2.26460546 3.52921093 1 -2 1
REM
:
LOCAL s$
LOCAL rootRealR1
LOCAL rootImagR1
LOCAL rootRealR2
LOCAL rootImagR2
LOCAL rootRealR3
LOCAL rootImagR3
LOCAL x11R
LOCAL x12R
LOCAL x13R
LOCAL x21R
LOCAL x22R
LOCAL x23R
LOCAL x31R
LOCAL x32R
LOCAL x33R
LOCAL result$
s$ = FNStringGetPhysicsCalculateEigenvalueGivenMatrix3DS( a11, a12,
a13, a21, a22, a23, a31, a32, a33, dimB%, printB% )
:
lambdaRealR1 = FNMathGetNumberCarFirstR( s$ )
lambdaImagR1 = FNMathGetNumberCarSecondR( s$ )
lambdaRealR2 = FNMathGetNumberCarThirdR( s$ )
lambdaImagR2 = FNMathGetNumberCarFourthR( s$ )
lambdaRealR3 = FNMathGetNumberCarFifthR( s$ )
lambdaImagR3 = FNMathGetNumberCarSixthR( s$ )
:
s$ = FNStringGetMathEigenVector3DS( a11, a12, a13, a21, a22, a23,
a31, a32, a33, lambdaRealR1, lambdaImagR1 )
result$ = FNStringGetConsS( result$, s$ )
x11R = FNMathGetNumberCarFirstR( s$ )
x12R = FNMathGetNumberCarSecondR( s$ )
x12R = FNMathGetNumberCarThirdR( s$ )
:
s$ = FNStringGetMathEigenVector3DS( a11, a12, a13, a21, a22, a23,
a31, a32, a33, lambdaRealR2, lambdaImagR2 )
result$ = FNStringGetConsS( result$, s$ )
x21R = FNMathGetNumberCarFirstR( s$ )
x22R = FNMathGetNumberCarSecondR( s$ )
x23R = FNMathGetNumberCarThirdR( s$ )
:
s$ = FNStringGetMathEigenVector3DS( a11, a12, a13, a21, a22, a23,
a31, a32, a33, lambdaRealR3, lambdaImagR3 )
result$ = FNStringGetConsS( result$, s$ )
x31R = FNMathGetNumberCarFirstR( s$ )
x32R = FNMathGetNumberCarSecondR( s$ )
x33R = FNMathGetNumberCarThirdR( s$ )
:
= result$
:
REM library: physics: calculate: eigenvalue: given: matrix3
(filenamemacro=calcphgm.bbc) [kn, ri, su, 22-01-2006 19:39:17]
DEF FNStringGetPhysicsCalculateEigenvalueGivenMatrix3DS( a11, a12,
a13, a21, a22, a23, a31, a32, a33, dimB%, printB% )
REM e.g. printB% = TRUE
REM e.g. dimB% = TRUE
REM e.g. a11 = 1
REM e.g. a12 = 2
REM e.g. a13 = 3
REM e.g. a21 = 4
REM e.g. a22 = 5
REM e.g. a23 = 6
REM e.g. a31 = 7
REM e.g. a32 = 8
REM e.g. a33 = 9
REM e.g. PRINT FNStringGetPhysicsCalculateEigenvalueGivenMatrix3DS(
a11, a12, a13, a21, a22, a23, a31, a32, a33, dimB%, printB% )
REM e.g. END
REM e.g. :
REM e.g. :
REM e.g. :
REM
REM
REM ---
REM
REM Running this example shows
REM
REM
REM ( 1 ) . x^3 + ( -15 ) . x^2 + ( -18 ) . x + ( 0 ) = 0
REM
REM solution: 3 roots:
REM
REM 3 real unequal roots
REM
REM real1 = -1.11684397
REM imag1 = 0
REM real2 = 16.116844
REM imag2 = 0
REM real3 = 0
REM imag3 = 0
REM
REM
REM result of filling in root1 in given equation gives: 8.94069672E-8
REM
REM result of filling in root2 in given equation gives: 8.34465027E-7
REM
REM result of filling in root3 in given equation gives: 0
REM
REM -----------------------------
REM
REM The resulting roots are stored in a string in the format
REM
REM root1real root1image root2real root2imag root3real root3imag
REM
REM which is then returned from the function
REM you can then use some string extract function
REM (searching e.g. for the space separator)
REM to get the individual roots out of that string
REM
REM -----------------------------
REM
REM -1.11684397 0 16.116844 0 0 0
:
LOCAL a
LOCAL b
LOCAL c
LOCAL d
:
a = 1
b = - (a11 + a22 + a33)
c = (a22 * a33 - a12 * a21 + a22 * a11 + a11 * a33 - a23 * a32 - a31
* a13)
d = (- a23 * a12 * a31 - a32 * a21 * a13 + a12 * a21 * a33 - a22 *
a11 * a33 + a23 * a32 * a11 + a22 * a31 * a13)
:
= FNStringGetMathEquationPolynomDegree3RootS( a, b, c, d, dimB%,
printB% )
:
REM library: math: get: number: car: first (filenamemacro=getmafr.bbc)
[kn, ri, su, 22-01-2006 22:20:34]
DEF FNMathGetNumberCarFirstR( s$ )
REM e.g. PRINT; FNMathGetNumberCarFirstR( "1.1 2.2 3.3 4.4 5.5 6.6
7.7 8.8 9.9" ) : REM gives 1.1
REM e.g. END
REM e.g. :
REM e.g. :
REM e.g. :
= FNMathGetNumberCarCentralR( s$, 1 )
:
REM library: math: get: number: car: second
(filenamemacro=getmasr.bbc) [kn, ri, su, 22-01-2006 22:20:38]
DEF FNMathGetNumberCarSecondR( s$ )
REM e.g. PRINT FNMathGetNumberCarSecondR( "1.1 2.2 3.3 4.4 5.5 6.6
7.7 8.8 9.9" ) : REM gives 2.2
REM e.g. END
REM e.g. :
REM e.g. :
REM e.g. :
= FNMathGetNumberCarCentralR( s$, 2 )
:
REM library: math: get: number: car: third (filenamemacro=getmatr.bbc)
[kn, ri, su, 22-01-2006 22:20:42]
DEF FNMathGetNumberCarThirdR( s$ )
REM e.g. PRINT FNMathGetNumberCarThirdR( "1.1 2.2 3.3 4.4 5.5 6.6 7.7
8.8 9.9" ) : REM gives 3.3
REM e.g. END
REM e.g. :
REM e.g. :
REM e.g. :
= FNMathGetNumberCarCentralR( s$, 3 )
:
REM library: math: get: number: car: fourth
(filenamemacro=getmafs.bbc) [kn, ri, su, 22-01-2006 22:20:45]
DEF FNMathGetNumberCarFourthR( s$ )
REM e.g. PRINT FNMathGetNumberCarFourthR( "1.1 2.2 3.3 4.4 5.5 6.6
7.7 8.8 9.9" ) : REM gives 4.4
REM e.g. END
REM e.g. :
REM e.g. :
REM e.g. :
= FNMathGetNumberCarCentralR( s$, 4 )
:
REM library: math: get: number: car: fifth (filenamemacro=getmaft.bbc)
[kn, ri, su, 22-01-2006 22:20:47]
DEF FNMathGetNumberCarFifthR( s$ )
REM e.g. PRINT FNMathGetNumberCarFifthR( "1.1 2.2 3.3 4.4 5.5 6.6 7.7
8.8 9.9" ) : REM gives 5.5
REM e.g. END
REM e.g. :
REM e.g. :
REM e.g. :
= FNMathGetNumberCarCentralR( s$, 5 )
:
REM library: math: get: number: car: sixth (filenamemacro=getmass.bbc)
[kn, ri, su, 22-01-2006 22:20:50]
DEF FNMathGetNumberCarSixthR( s$ )
REM e.g. PRINT FNMathGetNumberCarSixthR( "1.1 2.2 3.3 4.4 5.5 6.6 7.7
8.8 9.9" ) : REM gives 6.6
REM e.g. END
REM e.g. :
REM e.g. :
REM e.g. :
= FNMathGetNumberCarCentralR( s$, 6 )
:
REM library: math: get: eigen: vector3 (filenamemacro=getmadr.bbc)
[kn, ri, su, 22-01-2006 22:31:52]
DEF FNStringGetMathEigenVector3DS( a11, a12, a13, a21, a22, a23, a31,
a32, a33, lambdaRealR, lambdaImagR )
REM e.g. printB% = TRUE
REM e.g. dimB% = TRUE
REM e.g. a11 = 1
REM e.g. a12 = 2
REM e.g. a13 = 3
REM e.g. a21 = 4
REM e.g. a22 = 5
REM e.g. a23 = 6
REM e.g. a31 = 7
REM e.g. a32 = 8
REM e.g. a33 = 9
REM e.g. lambdaRealR = -1.11684397
REM e.g. lambdaImagR = 0
REM e.g. PRINT FNStringGetMathEigenVector3DS( a11, a12, a13, a21,
a22, a23, a31, a32, a33, lambdaRealR, lambdaImagR )
REM e.g. END
REM
REM ----
REM
REM for the moment only the real parts are taken, not the more
general complex solution
REM because it is meant to calculate inertia tensor rotations in 3D,
where real, symmetric matrices
REM will give 3 distinct real eigenvectors anyhow
REM
REM ---
REM
REM this value for lambda gives as a result
REM
REM 1 0.110394504 -0.779210992
REM
REM if normalized by dividing by the length of the vector, the answer
is 0.785830239 0.0992619116 -0.701294448
REM
LOCAL x1R
LOCAL x2R
LOCAL x3R
LOCAL denominatorR
LOCAL lengthR
:
denominatorR = ( a22 * a33 - a22 * lambdaRealR - lambdaRealR * a33 +
lambdaRealR^2 - a23 * a32 )
:
x1R = 1
x2R = x1R * ( a31 * a23 - a33 * a21 + lambdaRealR * a21 ) /
denominatorR
x3R = x1R * ( a21 * a32 - a22 * a31 + lambdaRealR * a31 ) /
denominatorR
:
xNormalize1R = FNMathGetVectorUnit3DXR( x1R, x2R, x3R ) : REM
normalized value for x1R
xNormalize2R = FNMathGetVectorUnit3DYR( x1R, x2R, x3R ) : REM
normalized value for x2R
xNormalize3R = FNMathGetVectorUnit3DZR( x1R, x2R, x3R ) : REM
normalized value for x3R
:
PRINT "normalized eigenvector = "; FNStringGetCons3S(
FNStringGetMathGetNumberRealToStringS( xNormalize1R ),
FNStringGetMathGetNumberRealToStringS( xNormalize2R ),
FNStringGetMathGetNumberRealToStringS( xNormalize3R ) )
:
= FNStringGetCons3S( FNStringGetMathGetNumberRealToStringS( x1R ),
FNStringGetMathGetNumberRealToStringS( x2R ),
FNStringGetMathGetNumberRealToStringS( x3R ) )
:
REM library: string: token: concatenate two strings to one, with one
extra space in between [kn, ri, th, 10-05-2001 14:33:30]
DEF FNStringGetConsS( s1$, s2$ )
IF s1$ = "" THEN = s2$
IF s2$ = "" THEN = s1$
= s1$ + " " + s2$
:
REM library: math: equation: polynom: degree: 3: root
(filenamemacro=solveqp3.bbc) [kn, ri, sa, 09-02-2002 00:22:52]
DEF FNStringGetMathEquationPolynomDegree3RootS( k3R, k2R, k1R, k0R,
dimB%, printB% )
REM e.g. PRINT FNStringGetMathEquationPolynomDegree3RootS( 1, -7, 0,
28, FNMathCheckLogicTrueB, FNMathCheckLogicTrueB )
REM e.g. END
REM
REM Running this program gives the following results
REM
REM ( 1 ) . x^3 + ( -7 ) . x^2 + ( 0 ) . x + ( 28 ) = 0
REM
REM solution: 3 roots:
REM
REM 3 real unequal roots
REM
REM real1 = -1.78526086
REM imag1 = 0
REM real2 = 6.29295138
REM imag2 = 0
REM real3 = 2.49230949
REM imag3 = 0
REM
REM
REM result1 = 8.19563866E-8
REM
REM result2 = -5.96046448E-8
REM
REM result3 = -3.7252903E-8
REM
REM -----------------------------
REM
REM The resulting roots are stored in a string in the format
REM
REM root1real root1image root2real root2imag root3real root3imag
REM
REM which is then returned from the function
REM you can then use some string extract function
REM (searching e.g. for the space separator)
REM to get the individual roots out of that string
REM
REM -----------------------------
REM
REM -1.78526086 0 6.29295138 0 2.49230949 0
REM
REM Press any key to continue . . .
REM
REM -----------------------------
LOCAL info$
LOCAL discriminantR
IF dimB% THEN PROCMathEquationPolynomDegree3RootDim( 3 )
discriminantR = FNMathEquationPolynomDegree3DeterminantR( k3R, k2R,
k1R, k0R )
info$ = FNMathEquationPolynomDegree3RootCaseS( discriminantR )
IF printB% THEN PROCMathEquationPolynomDegree3Print( k3R, k2R, k1R,
k0R ) : PROCMathEquationPolynomDegree3Test( k3R, k2R, k1R, k0R )
= FNStringGetMathEquationPolynomDegree3RootSolutionAllS( 3 )
ENDPROC
:
REM library: math: get: number: car: central
(filenamemacro=getmacr.bbc) [kn, ri, su, 22-01-2006 22:20:52]
DEF FNMathGetNumberCarCentralR( inS$, I% )
LOCAL s$
s$ = FNStringGetCarCentralS( inS$, I% )
= FNStringGetToNumberF( s$ )
END
:
REM library: math: VEKTOR: 3D: operatie unair: EENHEIDSVEKTOR
DEF FNMathGetVectorUnit3DXR( xR, yR, zR )
REM e.g. PRINT FNMathGetVectorUnit3DXR( 1, 1, 1 ) : REM gives 1 /
SquareRoot( 1^2 + 1^2 + 1^2 ) = 1 / SquareRoot( 3 ) = 0.577350269...
REM e.g. END
= FNNumberGetMathDivideR( xR, FNMathGetVectorLength3DR( xR, yR, zR ) )
:
DEF FNMathGetVectorUnit3DYR( xR, yR, zR )
REM e.g. PRINT FNMathGetVectorUnit3DYR( 1, 2, 1 ) : REM gives 2 /
SquareRoot( 2^2 + 1^2 + 1^2 ) = 2 / SquareRoot( 6 ) = 0.816496581...
REM e.g. END
= FNNumberGetMathDivideR( yR, FNMathGetVectorLength3DR( xR, yR, zR ) )
:
DEF FNMathGetVectorUnit3DZR( xR, yR, zR )
REM e.g. PRINT FNMathGetVectorUnit3DZR( 1, 2, 3 ) : REM gives 3 /
SquareRoot( 1^2 + 2^2 + 3^2 ) = 3 / SquareRoot( 14 ) = 0.801783726...
REM e.g. END
= FNNumberGetMathDivideR( zR, FNMathGetVectorLength3DR( xR, yR, zR ) )
:
REM library: string: concatenation: 3 strings [kn, ri, th, 10-05-2001
16:44:45]
DEF FNStringGetCons3S( s1$, s2$, s3$ )
REM e.g. PRINT; FNStringGetCons3S( "1", "2", "3" )
REM e.g. END
= FNStringGetConsS( FNStringGetConsS( s1$, s2$ ), s3$ )
REM variation = FNStringGetConsSeparatorS( s1$, s2$, s3$,
FNStringGetEmptyS )
:
REM library: math: get: number: real: to: string
(filenamemacro=getmatst.bbc) [kn, ri, su, 22-01-2006 20:21:52]
DEF FNStringGetMathGetNumberRealToStringS( x )
REM e.g. PRINT "'" + FNStringGetMathGetNumberRealToStringS( 3.14 )
+ "'"
REM e.g. END
REM :
REM :
REM :
= STR$( x )
:
REM library: math: logic: true: wrapper [kn, ri, mo, 04-02-2002
23:46:06]
DEF FNMathCheckLogicTrueB
= TRUE
:
REM library: math: equation: polynom: degree: 3: root: dim [kn, ri,
sa, 09-02-2002 01:20:59]
DEF PROCMathEquationPolynomDegree3RootDim( maxT% )
DIM xRA( maxT%, 1 )
ENDPROC
:
REM library: math: equation: polynom: degree: 3: root [kn, ri, sa, 09-
02-2002 00:22:52]
DEF FNMathEquationPolynomDegree3DeterminantR( k3R, k2R, k1R, k0R )
LOCAL hR
LOCAL p1R
LOCAL p2R
LOCAL q1R
LOCAL q2R
LOCAL q3R
hR = 3 * k3R
p1R = k1R / hR
p2R = - ( FNMathPowerR( k2R / hR, 2 ) )
q1R = FNMathPowerR( k2R / hR, 3 )
q2R = - ( k2R * k1R ) / ( 6 * FNMathPowerR( k3R, 2 ) )
q3R = k0R / ( 2 * k3R )
pR = p1R + p2R
qR = q1R + q2R + q3R
= ( FNMathPowerR( pR, 3 ) + FNMathPowerR( qR, 2 ) )
:
REM library: math: equation: polynom: degree: 3: root [kn, ri, sa, 09-
02-2002 00:22:52]
DEF FNMathEquationPolynomDegree3RootCaseS( discriminantR )
IF FNMathCheckNumberPositiveB( discriminantR ) THEN =
FNMathEquationPolynomDegree3Root1Real2ComplexS( discriminantR ) :
ENDPROC
IF FNMathCheckNumberEqualZeroB( discriminantR ) THEN =
FNMathEquationPolynomDegree3Root3RealEqualS( discriminantR ) : ENDPROC
IF FNMathCheckNumberNegativeB( discriminantR ) THEN =
FNMathEquationPolynomDegree3Root3RealEqualNotS( discriminantR ) :
ENDPROC
ENDPROC
:
REM library: math: equation: polynom: degree: 3: root [kn, ri, sa, 09-
02-2002 00:22:52]
DEF PROCMathEquationPolynomDegree3Print( k3R, k2R, k1R, k0R )
LOCAL T%
PRINT
PRINT;" ( "; k3R; " ) . x^3 + ( "; k2R; " ) . x^2 + ( "; k1R; " ) . x
+ ( "; k0R; " ) = 0"
PRINT
PRINT "solution: 3 roots: "
PRINT
PRINT info$
PRINT
FOR T% = 1 TO 3
PRINT "real"; T%; " = "; xRA( T%, 0 )
PRINT "imag"; T%; " = "; xRA( T%, 1 )
NEXT T%
PRINT
ENDPROC
:
DEF PROCMathEquationPolynomDegree3Test( k3R, k2R, k1R, k0R )
LOCAL result
LOCAL T%
FOR T% = 1 TO 3
result = k3R * FNMathPowerR( xRA( T%, 0 ), 3 ) + k2R * FNMathPowerR(
xRA( T%, 0 ), 2 ) + k1R * FNMathPowerR( xRA( T%, 0 ), 1 ) + k0R
PRINT
PRINT "result of filling in root"; T%; " in given equation gives: ";
result
NEXT T%
PRINT
PRINT "-----------------------------"
ENDPROC
:
REM library: string: get: math: equation: polynom: degree3: root:
solution: all (filenamemacro=getstas.bbc) [kn, ri, su, 22-01-2006
20:26:43]
DEF FNStringGetMathEquationPolynomDegree3RootSolutionAllS( maxI% )
REM e.g. DIM xRA( 3, 1 )
REM e.g.
REM e.g. xRA( 1, 0 ) = 1
REM e.g. xRA( 1, 1 ) = 2
REM e.g. xRA( 2, 0 ) = 3
REM e.g. xRA( 2, 1 ) = 4
REM e.g. xRA( 3, 0 ) = 5
REM e.g. xRA( 3, 1 ) = 6
REM e.g. PRINT FNStringGetMathEquationPolynomDegree3RootSolutionAllS(
3 )
REM e.g. END
LOCAL s$
LOCAL I%
LOCAL minI%
minI% = 1
FOR I% = minI% TO maxI%
s$ = FNStringGetCons3S( s$, FNStringGetMathGetNumberRealToStringS(
xRA( I%, 0 ) ), FNStringGetMathGetNumberRealToStringS( xRA( I%, 1 ) ) )
NEXT I%
= s$
:
REM library: string: get: car: central (filenamemacro=getstcce.bbc)
[kn, ri, su, 22-01-2006 22:00:42]
DEF FNStringGetCarCentralS( s$, I% )
= FNStringGetTokenFirstNS( s$, FNStringGetCharacterSymbolSpaceS, I% )
END
:
REM library: string: conversion: string to real [kn, ri, we, 16-05-
2001 18:14:40]
DEF FNStringGetToNumberF( s$ )
IF s$ = "" THEN PROCError( "string to integer : string may not be
empty" ) : = 0
= EVAL s$
:
REM library: math: number: DIVIDE + test on denominator = 0 : English
[kn, zoe, tu, 07-11-2000 20:59:26]
DEF FNNumberGetMathDivideR( numerator, denominator ) : REM version
with infinity external
LOCAL zero, denominatorzeroB%
denominatorzeroB% = ( denominator = 0 )
IF numerator = 0 AND denominatorzeroB% THEN PRINT; "0/0 = undefined,
every number satisfies this equation. E.g. 1000 * 0 = 0, but also 3 *
0 = 0, ..." : STOP
IF denominator = 0 THEN PROCError( "division by zero" ) : STOP
= numerator / denominator
:
REM library: math: get: vector: length3 (filenamemacro=getmads.bbc)
[kn, ri, su, 22-01-2006 22:59:45]
DEF FNMathGetVectorLength3DR( xR, yR, zR )
REM e.g. PRINT FNMathGetVectorLength3DR( 3, 4, 5 ) : REM gives
SquareRoot( 3^2 + 4^2 + 5^2 ) = SquareRoot( 9 + 16 + 25 ) = SquareRoot
( 50 ) = 7.07106781
REM e.g. END
= FNMathGetVectorDistance3DR( 0, 0, 0, xR, yR, zR )
REM = SQR( x ^ 2 + y ^ 2 + z ^ 2 ) : REM variant
:
REM library: string: token: concatenate two strings to one, with one
separator, with one extra space in between [kn, ri, fr, 11-05-2001
12:40:25]
DEF FNStringGetConsSeparatorS( s1$, s2$, separator$ )
= FNStringGetConsS( FNStringGetConcatS( s1$, separator$ ), s2$ )
:
REM library: string: return an empty string [kn, ri, we, 09-05-2001
19:53:53]
DEF FNStringGetEmptyS
= ""
:
REM library: math: power (with test for 0^power): real number as
result [kn, ri, sa, 09-02-2002 01:11:08]
DEF FNMathPowerR( xR, powerR )
= FNMathPowerF( xR, powerR )
:
REM library: math: number: positive? [kn, ri, su, 10-02-2002 16:06:00]
DEF FNMathCheckNumberPositiveB( xR )
= FNMathCheckNumberGreaterZeroB( xR )
:
REM library: math: equation: polynom: degree: 3: root [kn, ri, sa, 09-
02-2002 00:22:52]
DEF FNMathEquationPolynomDegree3Root1Real2ComplexS( discriminantR )
PROCMathEquationPolynomDegree3DiscriminantGreaterOrEqualZero(
discriminantR )
= "1 real and 2 complex roots"
:
REM library: math: number equal to ZERO? [kn, ri, th, 03-05-2001
14:19:57]
DEF FNMathCheckNumberEqualZeroB( xR )
= ( xR = 0 )
:
REM library: math: equation: polynom: degree: 3: root [kn, ri, sa, 09-
02-2002 00:22:52]
DEF FNMathEquationPolynomDegree3Root3RealEqualS( discriminantR )
LOCAL info$
IF FNMathLogicAndB( FNMathCheckNumberEqualZeroB( pR ),
FNMathCheckNumberEqualZeroB( qR ) ) THEN info$ = "3 real roots equal
to zero" ELSE info$ = "2 real equal roots, 1 root real and unequal"
PROCMathEquationPolynomDegree3DiscriminantGreaterOrEqualZero(
discriminantR )
= info$
:
REM library: math: number: negative? [kn, ri, su, 10-02-2002 16:06:06]
DEF FNMathCheckNumberNegativeB( xR )
= FNMathCheckNumberSmallerZeroB( xR )
:
REM library: math: equation: polynom: degree: 3: root [kn, ri, sa, 09-
02-2002 00:22:52]
DEF FNMathEquationPolynomDegree3Root3RealEqualNotS( discriminantR )
REM [book: see also: Bronshtein - guidebook of mathematics -
pR^3+qR^2 <= 0 - page 162]
LOCAL angleR
LOCAL cosphiR
LOCAL hR
LOCAL phiR
LOCAL rR
LOCAL radiusR
LOCAL sixtydegreesR
LOCAL yreal1R
LOCAL yimag1R
LOCAL yreal2R
LOCAL yimag2R
LOCAL yreal3R
LOCAL yimag3R
rR = FNMathSquareRootR( FNMathNumberAbsoluteR( pR ) )
cosphiR = qR / FNMathPowerR( rR, 3 )
phiR = FNMathTrigonometryCosToAngleR( cosphiR )
angleR = 1 / 3 * phiR
radiusR = 2 * rR
sixtydegreesR = FNMathPiR / 3
yreal1R = - radiusR * FNMathTrigonometryCosR( angleR )
yimag1R = 0
yreal2R = + radiusR * FNMathTrigonometryCosR( sixtydegreesR - angleR )
yimag2R = 0
yreal3R = + radiusR * FNMathTrigonometryCosR( sixtydegreesR + angleR )
yimag3R = 0
hR = k2R / ( 3 * k3R )
PROCMathEquationPolynomDegree3Result( yreal1R - hR, yimag1R, yreal2R -
hR, yimag2R, yreal3R - hR, yimag3R )
= "3 real unequal roots"
:
REM library: string: Nth token: get: separator [kn, zoe, th, 09-11-
2000 20:30:12]
DEF FNStringGetTokenFirstNS( s$, separator$, nrT% )
LOCAL T%
LOCAL first$
FOR T% = 1 TO nrT%
first$ = FNStringGetTokenFirstS( s$, separator$ )
s$ = FNStringGetTokenRestS( s$, separator$ )
NEXT T%
= first$
:
REM library: character: " [kn, ri, fr, 11-05-2001 14:43:25]
DEF FNStringGetCharacterSymbolSpaceS
= CHR$( 32 )
:
REM library: error [kn, zoe, mo, 06-11-2000 20:35:48]
DEF PROCError( info$ )
PRINT "Error: "; info$
errorB% = TRUE
ENDPROC
:
REM library: math: VECTOR: 3D: operation binary: DISTANCE between 2
vektors ( both vektors from same origin ) [kn, ri, mo, 23-01-2006
01:29:19]
DEF FNMathGetVectorDistance3DR( x1R, y1R, z1R, x2R, y2R, z2R )
REM e.g. PRINT FNMathGetVectorDistance3DR( 0, 0, 0, 3, 4, 5 ) : REM
gives 7.07106781
REM e.g. END
= FNMathSquareRootR( ( x2R - x1R ) ^ 2 + ( y2R - y1R ) ^ 2 + ( z2R -
z1R ) ^ 2 )
:
REM library: string: concatenate: two strings [kn, ri, th, 10-05-2001
14:32:25]
DEF FNStringGetConcatS( s1$, s2$ )
= s1$ + s2$
:
REM library: math: power (with test for 0^power): float [kn, ri, tu,
10-07-2001 14:53:07]
DEF FNMathPowerF( xR, powerR )
IF xR = 0 THEN = 0
= xR ^ powerR
:
REM library: math: number: number greater than zero? [kn, ri, su, 10-
02-2002 17:21:09]
DEF FNMathCheckNumberGreaterZeroB( xR )
= FNMathCheckNumberGreaterB( xR, 0 )
:
REM library: math: equation: polynom: degree: 3: root [kn, ri, sa, 09-
02-2002 00:22:52]
DEF PROCMathEquationPolynomDegree3DiscriminantGreaterOrEqualZero(
discriminantR )
REM [book: see also: van der Linden, C. - mathematical vademecum for
technicians - page 42 'Method of Cardano']
LOCAL discriminantsquarerootR
LOCAL h1R
LOCAL hR
LOCAL uR
LOCAL vR
LOCAL yreal1R
LOCAL yimag1R
LOCAL yreal2R
LOCAL yimag2R
LOCAL yreal3R
LOCAL yimag3R
discriminantsquarerootR = FNMathSquareRootR( discriminantR )
uR = FNMathThirdRootR( - qR + discriminantsquarerootR )
vR = FNMathThirdRootR( - qR - discriminantsquarerootR )
hR = FNMathSquareRootR( 3 ) / 2
yreal1R = uR + vR
yimag1R = 0
yreal2R = - (1/2) * yreal1R
yimag2R = hR * ( uR - vR )
yreal3R = yreal2R
yimag3R = - yimag2R
h1R = k2R / ( 3 * k3R )
PROCMathEquationPolynomDegree3Result( yreal1R - h1R, yimag1R,
yreal2R - h1R, yimag2R, yreal3R - h1R, yimag3R )
ENDPROC
:
REM library: math: logic: and [kn, ri, mo, 04-02-2002 23:47:07]
DEF FNMathLogicAndB( B1%, B2% )
REM e.g. <F12> PROCMessage( FNMathLogicAndB( FNMathCheckNumberEqualB(
employeepayD, hourlyD ), FNMathCheckNumberGreaterB( employee_hoursD,
40.0 ) ) ) REM gives ...
= ( B1% AND B2% )
:
REM library: math: number: compare: number1 SMALLER THAN or EQUAL THAN
zero? [kn, ri, tu, 05-02-2002 22:28:14]
DEF FNMathCheckNumberSmallerZeroB( xR )
= FNMathCheckNumberSmallerB( xR, 0 )
:
REM library: math: squareroot [kn, zoe, mo, 06-11-2000 20:35:33]
DEF FNMathSquareRootR( xR )
IF FNMathCheckNumberNegativeB( xR ) THEN PROCError( FNStringGetConsS
( "root from a negative number is not possible :",
FNMathGetIntegerToStringS( xR ) ) )
= SQR( xR )
:
REM library: math: funktion: ABSOLUTE VALUE [kn, ri, mo, 04-02-2002
23:28:09]
DEF FNMathNumberAbsoluteR( x )
= ABS( x )
:
REM library: math: trigonometry: cos: to: angle [kn, ri, sa, 09-02-
2002 02:22:16]
DEF FNMathTrigonometryCosToAngleR( cosR )
= ACS cosR
:
REM library: math: number: PI (=3.1415...) [kn, ri, sa, 09-02-2002
00:57:14]
DEF FNMathPiR
= PI
:
REM library: math: trigonometry: cos [kn, ri, su, 10-02-2002 16:26:57]
DEF FNMathTrigonometryCosR( angleR )
= COS angleR
:
REM library: math: equation: polynom: degree: 3R: root [kn, ri, sa, 09-
02-2002 00:22:52]
DEF PROCMathEquationPolynomDegree3Result( real1R, imag1R, real2R,
imag2R, real3R, imag3R )
xRA( 1, 0 ) = real1R
xRA( 1, 1 ) = imag1R
xRA( 2, 0 ) = real2R
xRA( 2, 1 ) = imag2R
xRA( 3, 0 ) = real3R
xRA( 3, 1 ) = imag3R
ENDPROC
:
REM library: string: token: get: first: separator [kn, zoe, th, 09-11-
2000 20:34:07]
DEF FNStringGetTokenFirstS( s$, separator$ )
REM e.g. PRINT; FNStringGetTokenFirstS( "24:22:00", ":" )
REM e.g. END
REM s$ = FNSpaceS( s$ ) : REM changed [kn, ri, fr, 25-05-2001 15:09:47]
LOCAL posT%
posT% = INSTR( s$, separator$ )
IF posT% <= 0 THEN = s$
= LEFT$( s$, posT% - 1 )
:
REM library: string: token: get: rest: separator [kn, zoe, th, 09-11-
2000 20:37:06]
DEF FNStringGetTokenRestS( s$, separator$ )
LOCAL posT%
REM s$ = FNSpaceS( s$ ) : REM changed [kn, ri, fr, 25-05-2001 15:09:07]
posT% = INSTR( s$, separator$ )
IF posT% = 0 THEN = ""
REM = FNSpaceS( MID$( s$, posT% + 1 ) ) : REM changed [kn, ri, fr, 25-
05-2001 15:09:35]
= MID$( s$, posT% + 1 )
:
REM library: math: number: number1 GREATER THAN number2? [kn, ri, th,
03-05-2001 12:50:03]
DEF FNMathCheckNumberGreaterB( x1R, x2R )
= ( x1R > x2R )
:
REM library: math: third: root [kn, ri, su, 10-02-2002 16:10:32]
DEF FNMathThirdRootR( xR )
LOCAL thirdrootR
IF FNMathCheckNumberEqualZeroB( xR ) THEN = 0
thirdrootR = FNMathPowerR( FNMathNumberAbsoluteR( xR ), 1/3 )
IF FNMathCheckNumberPositiveB( xR ) THEN = thirdrootR
= -thirdrootR
:
REM library: math: number: number1 EQUAL TO number2? [kn, ri, th, 03-
05-2001 12:51:27]
DEF FNMathCheckNumberEqualB( x1, x2 )
IF x1 = x2 THEN = TRUE ELSE = FALSE
:
REM library: math: number: number1 SMALLER THAN getal2? [kn, ri, th,
03-05-2001 13:59:36]
DEF FNMathCheckNumberSmallerB( x1R, x2R )
= ( x1R < x2R )
:
REM library: string: CONVERSION: NUMBER to STRING ( inverse of string
to number ) [kn, ri, th, 10-05-2001 18:04:38]
DEF FNMathGetIntegerToStringS( x )
REM e.g. PRINT "'" + FNMathGetIntegerToStringS( 3 ) + "'"
REM e.g. END
REM :
REM :
REM :
REM = STR$ x
= FNStringGetMathGetNumberRealToStringS( x )
:
REM library: string: SPACE: REMOVE: FRONT: RETURN: END [kn, ri, fr, 06-
07-2001 12:53:45]
DEF FNSpaceS( s$ )
IF LEFT$( s$, 1 ) <> " " THEN = s$ ELSE = FNSpaceS( RIGHT$( s$, LEN
s$ - 1 ) )
--- cut here: end ----------------------------------------------------
---
---
Internet: see also:
---
Math: Transformation: Eigenvector: Eigenvalue: Link: Can you give an
overview of links?
http://www.faqts.com/knowledge_base/view.phtml/aid/39001/fid/1856
----------------------------------------------------------------------
