Entry
Language: Computer: BBCBASIC: Math: Matrix: 3x3: Eigenvalue: How to get the eigenvalues?
Jan 22nd, 2006 14:10
Knud van Eeden,
----------------------------------------------------------------------
--- Knud van Eeden --- 22 January 2006 - 09:30 pm --------------------
Language: Computer: BBCBASIC: Math: Matrix: 3x3: Eigenvalue: How to
get the eigenvalues?
---
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 FNStringGetPhysicsCalculateEigenvalueGivenMatrix3DS( a11, a12,
a13, a21, a22, a23, a31, a32, a33, dimB%, printB% )
END
:
:
:
REM --- LIBRARY --- REM
:
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: 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: 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: 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: 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: 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: 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: 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( FNStringConcatS( s1$, separator$ ), s2$ )
:
REM library: string: return an empty string [kn, ri, we, 09-05-2001
19:53:53]
DEF FNStringGetEmptyS
= ""
:
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: error [kn, zoe, mo, 06-11-2000 20:35:48]
DEF PROCError( info$ )
PRINT "Error: "; info$
errorB% = TRUE
ENDPROC
:
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: concatenate: two strings [kn, ri, th, 10-05-2001
14:32:25]
DEF FNStringConcatS( s1$, s2$ )
= s1$ + s2$
--- 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
----------------------------------------------------------------------
