frequently ask ? : Computers : Programming : Languages : Bbcbasic

+ Search
Add Entry AlertManage Folder Edit Entry Add page to http://del.icio.us/
Did You Find This Entry Useful?

Entry

Language: Computer: BBCBASIC: Math: Polynom: Degree: 3: Numerical: How to get roots?

Jan 22nd, 2006 15:59
Knud van Eeden,


----------------------------------------------------------------------
--- Knud van Eeden --- 22 January 2006 - 06:46 pm --------------------
Language: Computer: BBCBASIC: Math: Polynom: Degree: 3: Numerical: How 
to get roots?
---
Solving the cubic equation
 a . x^3 + b . x^2 + c . x + d = 0
---
Method: Cardano formula
===
Steps: Overview:
 1. -Create e.g. the following program
--- cut here: begin --------------------------------------------------
 REM --- MAIN --- REM
PRINT FNStringGetMathEquationPolynomDegree3RootS( 1, -7, 0, 28, 
FNMathCheckLogicTrueB, FNMathCheckLogicTrueB )
END
REM --- LIBRARY --- REM
:
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
----------------------------------------------------------------------