Roots of a quadratic function: Difference between revisions
Thundergnat (talk | contribs) m (syntax highlighting fixup automation) |
m (→{{header|Wren}}: Minor tidy) |
||
(7 intermediate revisions by 4 users not shown) | |||
Line 1: | Line 1: | ||
{{task|Arithmetic operations}}{{Clarified-review}}Write a program to find the roots of a quadratic equation, i.e., solve the equation <math>ax^2 + bx + c = 0</math>. |
|||
{{task|Arithmetic operations}} |
|||
Your program must correctly handle non-real roots, but it need not check that <math>a \neq 0</math>. |
|||
The problem of solving a quadratic equation is a good example of how dangerous it can be to ignore the peculiarities of floating-point arithmetic. |
|||
;Task: |
|||
The obvious way to implement the quadratic formula suffers catastrophic loss of accuracy when one of the roots to be found is much closer to 0 than the other. |
|||
Create a program that finds and outputs the roots of a given function, range and (if applicable) step width. |
|||
In their classic textbook on numeric methods ''[http://www.pdas.com/fmm.htm Computer Methods for Mathematical Computations]'', George Forsythe, Michael Malcolm, and Cleve Moler suggest trying the naive algorithm with <math>a = 1</math>, <math>b = -10^5</math>, and <math>c = 1</math>. |
|||
(For double-precision floats, set <math>b = -10^9</math>.) |
|||
Consider the following implementation in [[Ada]]: |
|||
<syntaxhighlight lang="ada">with Ada.Text_IO; use Ada.Text_IO; |
|||
with Ada.Numerics.Elementary_Functions; use Ada.Numerics.Elementary_Functions; |
|||
procedure Quadratic_Equation is |
|||
The program should identify whether the root is exact or approximate. |
|||
type Roots is array (1..2) of Float; |
|||
function Solve (A, B, C : Float) return Roots is |
|||
SD : constant Float := sqrt (B**2 - 4.0 * A * C); |
|||
AA : constant Float := 2.0 * A; |
|||
begin |
|||
return ((- B + SD) / AA, (- B - SD) / AA); |
|||
end Solve; |
|||
R : constant Roots := Solve (1.0, -10.0E5, 1.0); |
|||
begin |
|||
Put_Line ("X1 =" & Float'Image (R (1)) & " X2 =" & Float'Image (R (2))); |
|||
end Quadratic_Equation;</syntaxhighlight> |
|||
{{out}} |
|||
<pre>X1 = 1.00000E+06 X2 = 0.00000E+00</pre> |
|||
As we can see, the second root has lost all significant figures. The right answer is that <code>X2</code> is about <math>10^{-6}</math>. The naive method is numerically unstable. |
|||
Suggested by Middlebrook (D-OA), a better numerical method: to define two parameters <math> q = \sqrt{a c} / b </math> and <math> f = 1/2 + \sqrt{1 - 4 q^2} /2 </math> |
|||
For this task, use: <big><big> ƒ(x) = x<sup>3</sup> - 3x<sup>2</sup> + 2x </big></big> |
|||
<br><br> |
|||
and the two roots of the quardratic are: <math> \frac{-b}{a} f </math> and <math> \frac{-c}{b f} </math> |
|||
=={{header|11l}}== |
|||
{{trans|Python}} |
|||
<syntaxhighlight lang="11l">F f(x) |
|||
R x^3 - 3 * x^2 + 2 * x |
|||
'''Task''': do it better. This means that given <math>a = 1</math>, <math>b = -10^9</math>, and <math>c = 1</math>, both of the roots your program returns should be greater than <math>10^{-11}</math>. Or, if your language can't do floating-point arithmetic any more precisely than single precision, your program should be able to handle <math>b = -10^6</math>. Either way, show what your program gives as the roots of the quadratic in question. See page 9 of |
|||
-V step = 0.001 |
|||
[https://www.validlab.com/goldberg/paper.pdf "What Every Scientist Should Know About Floating-Point Arithmetic"] for a possible algorithm. |
|||
-V start = -1.0 |
|||
-V stop = 3.0 |
|||
=={{header|11l}}== |
|||
V sgn = f(start) > 0 |
|||
<syntaxhighlight lang="11l">F quad_roots(a, b, c) |
|||
V x = start |
|||
V sqd = Complex(b^2 - 4*a*c) ^ 0.5 |
|||
R ((-b + sqd) / (2 * a), |
|||
(-b - sqd) / (2 * a)) |
|||
V testcases = [(3.0, 4.0, 4 / 3), |
|||
L x <= stop |
|||
(3.0, 2.0, -1.0), |
|||
(3.0, 2.0, 1.0), |
|||
(1.0, -1e9, 1.0), |
|||
(1.0, -1e100, 1.0)] |
|||
L(a, b, c) testcases |
|||
I value == 0 |
|||
V (r1, r2) = quad_roots(a, b, c) |
|||
print(‘Root found at ’x) |
|||
print(r1, end' ‘ ’) |
|||
E I (value > 0) != sgn |
|||
print(r2)</syntaxhighlight> |
|||
print(‘Root found near ’x) |
|||
sgn = value > 0 |
|||
x += step</syntaxhighlight> |
|||
{{out}} |
{{out}} |
||
<pre> |
<pre> |
||
-0.666667+0i -0.666667+0i |
|||
Root found near 8.812395258e-16 |
|||
0.333333+0i -1+0i |
|||
Root found near 1 |
|||
-0.333333+0.471405i -0.333333-0.471405i |
|||
Root found near 2.001 |
|||
1e+09+0i 0i |
|||
1e+100+0i 0i |
|||
</pre> |
</pre> |
||
=={{header|Ada}}== |
=={{header|Ada}}== |
||
<syntaxhighlight lang="ada">with Ada. |
<syntaxhighlight lang="ada">with Ada.Text_IO; use Ada.Text_IO; |
||
with Ada.Numerics.Elementary_Functions; use Ada.Numerics.Elementary_Functions; |
|||
procedure Roots_Of_Function is |
|||
procedure Quadratic_Equation is |
|||
package Real_Io is new Ada.Text_Io.Float_Io(Long_Float); |
|||
type Roots is array (1..2) of Float; |
|||
use Real_Io; |
|||
function Solve (A, B, C : Float) return Roots is |
|||
SD : constant Float := sqrt (B**2 - 4.0 * A * C); |
|||
function F(X : Long_Float) return Long_Float is |
|||
X : Float; |
|||
begin |
begin |
||
if B < 0.0 then |
|||
X := (- B + SD) / (2.0 * A); |
|||
end F; |
|||
return (X, C / (A * X)); |
|||
else |
|||
Step : constant Long_Float := 1.0E-6; |
|||
X := (- B - SD) / (2.0 * A); |
|||
return (C / (A * X), X); |
|||
Stop : constant Long_Float := 3.0; |
|||
Value : Long_Float := F(Start); |
|||
Sign : Boolean := Value > 0.0; |
|||
X : Long_Float := Start + Step; |
|||
begin |
|||
if Value = 0.0 then |
|||
Put("Root found at "); |
|||
Put(Item => Start, Fore => 1, Aft => 6, Exp => 0); |
|||
New_Line; |
|||
end if; |
|||
while X <= Stop loop |
|||
Value := F(X); |
|||
if (Value > 0.0) /= Sign then |
|||
Put("Root found near "); |
|||
Put(Item => X, Fore => 1, Aft => 6, Exp => 0); |
|||
New_Line; |
|||
elsif Value = 0.0 then |
|||
Put("Root found at "); |
|||
Put(Item => X, Fore => 1, Aft => 6, Exp => 0); |
|||
New_Line; |
|||
end if; |
end if; |
||
end Solve; |
|||
Sign := Value > 0.0; |
|||
X := X + Step; |
|||
R : constant Roots := Solve (1.0, -10.0E5, 1.0); |
|||
end loop; |
|||
begin |
|||
end Roots_Of_Function;</syntaxhighlight> |
|||
Put_Line ("X1 =" & Float'Image (R (1)) & " X2 =" & Float'Image (R (2))); |
|||
end Quadratic_Equation;</syntaxhighlight> |
|||
Here precision loss is prevented by checking signs of operands. On errors, Constraint_Error is propagated on numeric errors and when roots are complex. |
|||
{{out}} |
|||
<pre> |
|||
X1 = 1.00000E+06 X2 = 1.00000E-06 |
|||
</pre> |
|||
=={{header|ALGOL 68}}== |
=={{header|ALGOL 68}}== |
||
{{trans|Ada}} |
|||
{{works with|ALGOL 68|Revision 1 - no extensions to language used}} |
{{works with|ALGOL 68|Revision 1 - no extensions to language used}} |
||
{{works with|ALGOL 68G|Any - tested with release [http://sourceforge.net/projects/algol68/files/algol68g/algol68g-1.18.0/algol68g-1.18.0-9h.tiny.el5.centos.fc11.i386.rpm/download 1.18.0-9h.tiny]}} |
{{works with|ALGOL 68G|Any - tested with release [http://sourceforge.net/projects/algol68/files/algol68g/algol68g-1.18.0/algol68g-1.18.0-9h.tiny.el5.centos.fc11.i386.rpm/download 1.18.0-9h.tiny]}} |
||
{{wont work with|ELLA ALGOL 68|Any (with appropriate job cards) - tested with release [http://sourceforge.net/projects/algol68/files/algol68toc/algol68toc-1.8.8d/algol68toc-1.8-8d.fc9.i386.rpm/download 1.8-8d] - |
{{wont work with|ELLA ALGOL 68|Any (with appropriate job cards) - tested with release [http://sourceforge.net/projects/algol68/files/algol68toc/algol68toc-1.8.8d/algol68toc-1.8-8d.fc9.i386.rpm/download 1.8-8d] - probably need to "USE" the compl ENVIRON}} |
||
<syntaxhighlight lang="algol68">quadratic equation: |
|||
Finding 3 roots using the secant method: |
|||
BEGIN |
|||
<syntaxhighlight lang="algol68">MODE DBL = LONG REAL; |
|||
FORMAT dbl = $g(-long real width, long real width-6, -2)$; |
|||
MODE |
MODE ROOTS = UNION([]REAL, []COMPL); |
||
MODE QUADRATIC = STRUCT(REAL a,b,c); |
|||
FORMAT xy root = $f(dbl)" ("b("Exactly", "Approximately")")"$; |
|||
PROC solve = (QUADRATIC q)ROOTS: |
|||
MODE DBLOPT = UNION(DBL, VOID); |
|||
BEGIN |
|||
MODE XYRES = UNION(XY, VOID); |
|||
REAL a = a OF q, b = b OF q, c = c OF q; |
|||
REAL sa = b**2 - 4*a*c; |
|||
IF sa >=0 THEN # handle the +ve case as REAL # |
|||
REAL sqrt sa = ( b<0 | sqrt(sa) | -sqrt(sa)); |
|||
REAL r1 = (-b + sqrt sa)/(2*a), |
|||
r2 = (-b - sqrt sa)/(2*a); |
|||
[]REAL((r1,r2)) |
|||
ELSE # handle the -ve case as COMPL conjugate pairs # |
|||
COMPL compl sqrt sa = ( b<0 | complex sqrt(sa) | -complex sqrt(sa)); |
|||
COMPL r1 = (-b + compl sqrt sa)/(2*a), |
|||
r2 = (-b - compl sqrt sa)/(2*a); |
|||
[]COMPL (r1, r2) |
|||
FI |
|||
END # solve #; |
|||
PROC real evaluate = (QUADRATIC q, REAL x )REAL: (a OF q*x + b OF q)*x + c OF q; |
|||
PROC compl evaluate = (QUADRATIC q, COMPL x)COMPL: (a OF q*x + b OF q)*x + c OF q; |
|||
# only a very tiny difference between the 2 examples # |
|||
PROC find root = (PROC (DBL)DBL f, DBLOPT in x1, in x2, in x error, in y error)XYRES:( |
|||
[]QUADRATIC test = ((1, -10e5, 1), (1, 0, 1), (1,-3,2), (1,3,2), (4,0,4), (3,4,5)); |
|||
INT limit = ENTIER (long real width / log(2)); # worst case of a binary search) # |
|||
DBL x1 := (in x1|(DBL x1):x1|-5.0), # if x1 is EMPTY then -5.0 # |
|||
FORMAT real fmt = $g(-0,8)$; |
|||
x2 := (in x2|(DBL x2):x2|+5.0), |
|||
FORMAT compl fmt = $f(real fmt)"+"f(real fmt)"i"$; |
|||
x error := (in x error|(DBL x error):x error|small real), |
|||
FORMAT quadratic fmt = $f(real fmt)" x**2 + "f(real fmt)" x + "f(real fmt)" = 0"$; |
|||
y error := (in y error|(DBL y error):y error|small real); |
|||
DBL y1 := f(x1), y2; |
|||
DBL dx := x1 - x2, dy; |
|||
FOR index TO UPB test DO |
|||
QUADRATIC quadratic = test[index]; |
|||
XY(x1, y1) # we already have a solution! # |
|||
ROOTS r = solve(quadratic); |
|||
ELSE |
|||
FOR i WHILE |
|||
# Output the two different scenerios # |
|||
y2 := f(x2); |
|||
printf(($"Quadratic: "$, quadratic fmt, quadratic, $l$)); |
|||
IF y2 = 0 THEN stop iteration FI; |
|||
CASE r IN |
|||
IF i = limit THEN value error FI; |
|||
([]REAL r): |
|||
IF y1 = y2 THEN value error FI; |
|||
printf(($"REAL x1 = "$, real fmt, r[1], |
|||
$", x2 = "$, real fmt, r[2], $"; "$, |
|||
$"REAL y1 = "$, real fmt, real evaluate(quadratic,r[1]), |
|||
x1 := x2; y1 := y2; # retain for next iteration # |
|||
$", y2 = "$, real fmt, real evaluate(quadratic,r[2]), $";"ll$ |
|||
x2 -:= dx; |
|||
)), |
|||
# WHILE # ABS dx > x error AND ABS dy > y error DO |
|||
([]COMPL c): |
|||
printf(($"COMPL x1,x2 = "$, real fmt, re OF c[1], $"+/-"$, |
|||
OD; |
|||
real fmt, ABS im OF c[1], $"; "$, |
|||
stop iteration: |
|||
$"COMPL y1 = "$, compl fmt, compl evaluate(quadratic,c[1]), |
|||
XY(x2, y2) EXIT |
|||
$", y2 = "$, compl fmt, compl evaluate(quadratic,c[2]), $";"ll$ |
|||
value error: |
|||
)) |
|||
ESAC |
|||
OD |
|||
); |
|||
END # quadratic_equation #</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
Quadratic: 1.00000000 x**2 + -1000000.00000000 x + 1.00000000 = 0 |
|||
REAL x1 = 999999.99999900, x2 = .00000100; REAL y1 = -.00000761, y2 = -.00000761; |
|||
Quadratic: 1.00000000 x**2 + .00000000 x + 1.00000000 = 0 |
|||
PROC f = (DBL x)DBL: x UP 3 - LONG 3.1 * x UP 2 + LONG 2.0 * x; |
|||
COMPL x1,x2 = .00000000+/-1.00000000; COMPL y1 = .00000000+.00000000i, y2 = .00000000+.00000000i; |
|||
Quadratic: 1.00000000 x**2 + -3.00000000 x + 2.00000000 = 0 |
|||
DBL first root, second root, third root; |
|||
REAL x1 = 2.00000000, x2 = 1.00000000; REAL y1 = .00000000, y2 = .00000000; |
|||
Quadratic: 1.00000000 x**2 + 3.00000000 x + 2.00000000 = 0 |
|||
XYRES first result = find root(f, LENG -1.0, LENG 3.0, EMPTY, EMPTY); |
|||
REAL x1 = -2.00000000, x2 = -1.00000000; REAL y1 = .00000000, y2 = .00000000; |
|||
CASE first result IN |
|||
(XY first result): ( |
|||
printf(($"1st root found at x = "f(xy root)l$, x OF first result, y OF first result=0)); |
|||
first root := x OF first result |
|||
) |
|||
OUT printf($"No first root found"l$); stop |
|||
ESAC; |
|||
Quadratic: 4.00000000 x**2 + .00000000 x + 4.00000000 = 0 |
|||
XYRES second result = find root( (DBL x)DBL: f(x) / (x - first root), EMPTY, EMPTY, EMPTY, EMPTY); |
|||
COMPL x1,x2 = .00000000+/-1.00000000; COMPL y1 = .00000000+.00000000i, y2 = .00000000+.00000000i; |
|||
CASE second result IN |
|||
(XY second result): ( |
|||
printf(($"2nd root found at x = "f(xy root)l$, x OF second result, y OF second result=0)); |
|||
second root := x OF second result |
|||
) |
|||
OUT printf($"No second root found"l$); stop |
|||
ESAC; |
|||
Quadratic: 3.00000000 x**2 + 4.00000000 x + 5.00000000 = 0 |
|||
XYRES third result = find root( (DBL x)DBL: f(x) / (x - first root) / ( x - second root ), EMPTY, EMPTY, EMPTY, EMPTY); |
|||
COMPL x1,x2 = -.66666667+/-1.10554160; COMPL y1 = .00000000+.00000000i, y2 = .00000000+-.00000000i; |
|||
CASE third result IN |
|||
(XY third result): ( |
|||
printf(($"3rd root found at x = "f(xy root)l$, x OF third result, y OF third result=0)); |
|||
third root := x OF third result |
|||
) |
|||
OUT printf($"No third root found"l$); stop |
|||
ESAC</syntaxhighlight> |
|||
Output: |
|||
<pre>1st root found at x = 9.1557112297752398099031e-1 (Approximately) |
|||
2nd root found at x = 2.1844288770224760190097e 0 (Approximately) |
|||
3rd root found at x = 0.0000000000000000000000e 0 (Exactly) |
|||
</pre> |
</pre> |
||
=={{header|ATS}}== |
|||
<syntaxhighlight lang="ats"> |
|||
#include |
|||
"share/atspre_staload.hats" |
|||
typedef d = double |
|||
fun |
|||
findRoots |
|||
( |
|||
start: d, stop: d, step: d, f: (d) -> d, nrts: int, A: d |
|||
) : void = ( |
|||
// |
|||
if |
|||
start < stop |
|||
then let |
|||
val A2 = f(start) |
|||
var nrts: int = nrts |
|||
val () = |
|||
if A2 = 0.0 |
|||
then ( |
|||
nrts := nrts + 1; |
|||
$extfcall(void, "printf", "An exact root is found at %12.9f\n", start) |
|||
) (* end of [then] *) |
|||
// end of [if] |
|||
val () = |
|||
if A * A2 < 0.0 |
|||
then ( |
|||
nrts := nrts + 1; |
|||
$extfcall(void, "printf", "An approximate root is found at %12.9f\n", start) |
|||
) (* end of [then] *) |
|||
// end of [if] |
|||
in |
|||
findRoots(start+step, stop, step, f, nrts, A2) |
|||
end // end of [then] |
|||
else ( |
|||
if nrts = 0 |
|||
then $extfcall(void, "printf", "There are no roots found!\n") |
|||
// end of [if] |
|||
) (* end of [else] *) |
|||
// |
|||
) (* end of [findRoots] *) |
|||
(* ****** ****** *) |
|||
implement |
|||
main0 () = |
|||
findRoots (~1.0, 3.0, 0.001, lam (x) => x*x*x - 3.0*x*x + 2.0*x, 0, 0.0) |
|||
</syntaxhighlight> |
|||
=={{header|AutoHotkey}}== |
=={{header|AutoHotkey}}== |
||
ahk forum: [http://www.autohotkey.com/forum/viewtopic.php?p=276617#276617 discussion] |
|||
Poly(x) is a test function of one variable, here we are searching for its roots: |
|||
<syntaxhighlight lang="autohotkey">MsgBox % quadratic(u,v, 1,-3,2) ", " u ", " v |
|||
* roots() searches for intervals within given limits, shifted by a given “step”, where our function has different signs at the endpoints. |
|||
MsgBox % quadratic(u,v, 1,3,2) ", " u ", " v |
|||
* Having found such an interval, the root() function searches for a value where our function is 0, within a given tolerance. |
|||
MsgBox % quadratic(u,v, -2,4,-2) ", " u ", " v |
|||
* It also sets ErrorLevel to info about the root found. |
|||
MsgBox % quadratic(u,v, 1,0,1) ", " u ", " v |
|||
SetFormat FloatFast, 0.15e |
|||
MsgBox % quadratic(u,v, 1,-1.0e8,1) ", " u ", " v |
|||
quadratic(ByRef x1, ByRef x2, a,b,c) { ; -> #real roots {x1,x2} of ax²+bx+c |
|||
[http://www.autohotkey.com/forum/viewtopic.php?t=44657&postdays=0&postorder=asc&start=139 discussion] |
|||
If (a = 0) |
|||
<syntaxhighlight lang="autohotkey">MsgBox % roots("poly", -0.99, 2, 0.1, 1.0e-5) |
|||
Return -1 ; ERROR: not quadratic |
|||
MsgBox % roots("poly", -1, 3, 0.1, 1.0e-5) |
|||
d := b*b - 4*a*c |
|||
If (d < 0) { |
|||
roots(f,x1,x2,step,tol) { ; search for roots in intervals of length "step", within tolerance "tol" |
|||
x1 := x2 := "" |
|||
Return 0 |
|||
Loop % ceil((x2-x1)/step) { |
|||
x += step, y := %f%(x), t := (y>0)-(y<0) |
|||
If (s=0 || s!=t) |
|||
res .= root(f, x-step, x, tol) " [" ErrorLevel "]`n" |
|||
s := t |
|||
} |
} |
||
If (d = 0) { |
|||
Sort res, UN ; remove duplicate endpoints |
|||
x1 := x2 := -b/2/a |
|||
Return res |
|||
Return 1 |
|||
} |
|||
root(f,x1,x2,d) { ; find x in [x1,x2]: f(x)=0 within tolerance d, by bisection |
|||
If (!y1 := %f%(x1)) |
|||
Return x1, ErrorLevel := "Exact" |
|||
If (!y2 := %f%(x2)) |
|||
Return x2, ErrorLevel := "Exact" |
|||
If (y1*y2>0) |
|||
Return "", ErrorLevel := "Need different sign ends!" |
|||
Loop { |
|||
x := (x2+x1)/2, y := %f%(x) |
|||
If (y = 0 || x2-x1 < d) |
|||
Return x, ErrorLevel := y ? "Approximate" : "Exact" |
|||
If ((y>0) = (y1>0)) |
|||
x1 := x, y1 := y |
|||
Else |
|||
x2 := x, y2 := y |
|||
} |
} |
||
x1 := (-b - (b<0 ? -sqrt(d) : sqrt(d)))/2/a |
|||
} |
|||
x2 := c/a/x1 |
|||
Return 2 |
|||
poly(x) { |
|||
Return ((x-3)*x+2)*x |
|||
}</syntaxhighlight> |
}</syntaxhighlight> |
||
=={{header|Axiom}}== |
|||
Using a polynomial solver: |
|||
<syntaxhighlight lang="axiom">expr := x^3-3*x^2+2*x |
|||
solve(expr,x)</syntaxhighlight> |
|||
Output: |
|||
<syntaxhighlight lang="axiom"> (1) [x= 2,x= 1,x= 0] |
|||
Type: List(Equation(Fraction(Polynomial(Integer))))</syntaxhighlight> |
|||
Using the secant method in the interpreter: |
|||
<syntaxhighlight lang="axiom">digits(30) |
|||
secant(eq: Equation Expression Float, binding: SegmentBinding(Float)):Float == |
|||
eps := 1.0e-30 |
|||
expr := lhs eq - rhs eq |
|||
x := variable binding |
|||
seg := segment binding |
|||
x1 := lo seg |
|||
x2 := hi seg |
|||
fx1 := eval(expr, x=x1)::Float |
|||
abs(fx1)<eps => return x1 |
|||
for i in 1..100 repeat |
|||
fx2 := eval(expr, x=x2)::Float |
|||
abs(fx2)<eps => return x2 |
|||
(x1, fx1, x2) := (x2, fx2, x2 - fx2 * (x2 - x1) / (fx2 - fx1)) |
|||
error "Function not converging."</syntaxhighlight> |
|||
The example can now be called using: |
|||
<syntaxhighlight lang="axiom">secant(expr=0,x=-0.5..0.5)</syntaxhighlight> |
|||
=={{header|BBC BASIC}}== |
=={{header|BBC BASIC}}== |
||
<syntaxhighlight lang="bbcbasic"> |
<syntaxhighlight lang="bbcbasic"> FOR test% = 1 TO 7 |
||
READ a$, b$, c$ |
|||
PRINT "For a = " ; a$ ", b = " ; b$ ", c = " ; c$ TAB(32) ; |
|||
rangemax = 3 |
|||
PROCsolvequadratic(EVAL(a$), EVAL(b$), EVAL(c$)) |
|||
stepsize = 0.001 |
|||
NEXT |
|||
PROCroots(function$, rangemin, rangemax, stepsize, accuracy) |
|||
END |
END |
||
DATA 1, -1E9, 1 |
|||
DATA 1, 0, 1 |
|||
DATA 2, -1, -6 |
|||
DATA 1, 2, -2 |
|||
DATA 0.5, SQR(2), 1 |
|||
DATA 1, 3, 2 |
|||
DATA 3, 4, 5 |
|||
PRINT "Root found at x = "; x |
|||
DEF PROCsolvequadratic(a, b, c) |
|||
ELSE IF sign% <> oldsign% AND oldsign% <> 0 THEN |
|||
LOCAL d, f |
|||
d = b^2 - 4*a*c |
|||
PRINT "Root found near x = "; x |
|||
CASE SGN(d) OF |
|||
WHEN 0: |
|||
PROCroots(func$, x-inc, x+inc/8, inc/8, eps) |
|||
PRINT "the single root is " ; -b/2/a |
|||
WHEN +1: |
|||
f = (1 + SQR(1-4*a*c/b^2))/2 |
|||
PRINT "the real roots are " ; -f*b/a " and " ; -c/b/f |
|||
oldsign% = sign% |
|||
WHEN -1: |
|||
PRINT "the complex roots are " ; -b/2/a " +/- " ; SQR(-d)/2/a "*i" |
|||
ENDCASE |
|||
ENDPROC</syntaxhighlight> |
ENDPROC</syntaxhighlight> |
||
{{out}} |
|||
Output: |
|||
<pre>For a = 1, b = -1E9, c = 1 the real roots are 1E9 and 1E-9 |
|||
<pre>Root found near x = 2.29204307E-9 |
|||
For a = 1, b = 0, c = 1 the complex roots are 0 +/- 1*i |
|||
Root found near x = 1 |
|||
For a = 2, b = -1, c = -6 the real roots are 2 and -1.5 |
|||
Root found at x = 2</pre> |
|||
For a = 1, b = 2, c = -2 the real roots are -2.73205081 and 0.732050808 |
|||
For a = 0.5, b = SQR(2), c = 1 the single root is -1.41421356 |
|||
For a = 1, b = 3, c = 2 the real roots are -2 and -1 |
|||
For a = 3, b = 4, c = 5 the complex roots are -0.666666667 +/- 1.1055416*i</pre> |
|||
=={{header|C}}== |
=={{header|C}}== |
||
Code that tries to avoid floating point overflow and other unfortunate loss of precissions: (compiled with <code>gcc -std=c99</code> for <code>complex</code>, though easily adapted to just real numbers) |
|||
<syntaxhighlight lang="c">#include <stdio.h> |
|||
#include <stdlib.h> |
|||
#include <complex.h> |
|||
#include <math.h> |
|||
typedef double complex cplx; |
|||
=== Secant Method === |
|||
void quad_root |
|||
<syntaxhighlight lang="c">#include <math.h> |
|||
(double a, double b, double c, cplx * ra, cplx *rb) |
|||
#include <stdio.h> |
|||
double f(double x) |
|||
{ |
{ |
||
double d, e; |
|||
return x*x*x-3.0*x*x +2.0*x; |
|||
if (!a) { |
|||
} |
|||
*ra = b ? -c / b : 0; |
|||
*rb = 0; |
|||
return; |
|||
} |
|||
if (!c) { |
|||
*ra = 0; |
|||
*rb = -b / a; |
|||
return; |
|||
} |
|||
b /= 2; |
|||
double secant( double xA, double xB, double(*f)(double) ) |
|||
if (fabs(b) > fabs(c)) { |
|||
{ |
|||
e = 1 - (a / b) * (c / b); |
|||
d = sqrt(fabs(e)) * fabs(b); |
|||
double fA, fB; |
|||
} else { |
|||
double d; |
|||
e = (c > 0) ? a : -a; |
|||
e = b * (b / fabs(c)) - e; |
|||
d = sqrt(fabs(e)) * sqrt(fabs(c)); |
|||
} |
|||
if (e < 0) { |
|||
fA=(*f)(xA); |
|||
e = fabs(d / a); |
|||
for (i=0; i<limit; i++) { |
|||
d = -b / a; |
|||
fB=(*f)(xB); |
|||
*ra = d + I * e; |
|||
*rb = d - I * e; |
|||
return; |
|||
break; |
|||
} |
|||
xA = xB; |
|||
fA = fB; |
|||
d = (b >= 0) ? d : -d; |
|||
e = (d - b) / a; |
|||
d = e ? (c / e) / a : 0; |
|||
*ra = d; |
|||
printf("Function is not converging near (%7.4f,%7.4f).\n", xA,xB); |
|||
*rb = e; |
|||
return -99.0; |
|||
return; |
|||
} |
|||
return xB; |
|||
} |
} |
||
int main( |
int main() |
||
{ |
{ |
||
cplx ra, rb; |
|||
double step = 1.0e-2; |
|||
quad_root(1, 1e12 + 1, 1e12, &ra, &rb); |
|||
double e = 1.0e-12; |
|||
printf("(%g + %g i), (%g + %g i)\n", |
|||
double x = -1.032; // just so we use secant method |
|||
creal(ra), cimag(ra), creal(rb), cimag(rb)); |
|||
double xx, value; |
|||
quad_root(1e300, -1e307 + 1, 1e300, &ra, &rb); |
|||
int s = (f(x)> 0.0); |
|||
printf("(%g + %g i), (%g + %g i)\n", |
|||
creal(ra), cimag(ra), creal(rb), cimag(rb)); |
|||
return 0; |
|||
while (x < 3.0) { |
|||
value = f(x); |
|||
if (fabs(value) < e) { |
|||
printf("Root found at x= %12.9f\n", x); |
|||
s = (f(x+.0001)>0.0); |
|||
} |
|||
else if ((value > 0.0) != s) { |
|||
xx = secant(x-step, x,&f); |
|||
if (xx != -99.0) // -99 meaning secand method failed |
|||
printf("Root found at x= %12.9f\n", xx); |
|||
else |
|||
printf("Root found near x= %7.4f\n", x); |
|||
s = (f(x+.0001)>0.0); |
|||
} |
|||
x += step; |
|||
} |
|||
return 0; |
|||
}</syntaxhighlight> |
}</syntaxhighlight> |
||
{{out}}<pre>(-1e+12 + 0 i), (-1 + 0 i) |
|||
(1.00208e+07 + 0 i), (9.9792e-08 + 0 i)</pre> |
|||
<syntaxhighlight lang="c">#include <stdio.h> |
|||
=== GNU Scientific Library === |
|||
#include <math.h> |
|||
#include <complex.h> |
|||
void roots_quadratic_eq(double a, double b, double c, complex double *x) |
|||
<syntaxhighlight lang="c">#include <gsl/gsl_poly.h> |
|||
#include <stdio.h> |
|||
int main(int argc, char *argv[]) |
|||
{ |
{ |
||
double delta; |
|||
/* 0 + 2x - 3x^2 + 1x^3 */ |
|||
double p[] = {0, 2, -3, 1}; |
|||
double z[6]; |
|||
gsl_poly_complex_workspace *w = gsl_poly_complex_workspace_alloc(4); |
|||
gsl_poly_complex_solve(p, 4, w, z); |
|||
gsl_poly_complex_workspace_free(w); |
|||
delta = b*b - 4.0*a*c; |
|||
for(int i = 0; i < 3; ++i) |
|||
x[0] = (-b + csqrt(delta)) / (2.0*a); |
|||
x[1] = (-b - csqrt(delta)) / (2.0*a); |
|||
return 0; |
|||
}</syntaxhighlight> |
}</syntaxhighlight> |
||
One can also use the GNU Scientific Library to find roots of functions. Compile with <pre>gcc roots.c -lgsl -lcblas -o roots</pre> |
|||
=={{header|C sharp|C#}}== |
|||
{{trans|C++}} |
{{trans|C++}} |
||
<syntaxhighlight lang="c">void roots_quadratic_eq2(double a, double b, double c, complex double *x) |
|||
<syntaxhighlight lang="csharp">using System; |
|||
class Program |
|||
{ |
{ |
||
b /= a; |
|||
public static void Main(string[] args) |
|||
c /= a; |
|||
double delta = b*b - 4*c; |
|||
if ( delta < 0 ) { |
|||
x[0] = -b/2 + I*sqrt(-delta)/2.0; |
|||
double step = 0.001; // Smaller step values produce more accurate and precise results |
|||
x[1] = -b/2 - I*sqrt(-delta)/2.0; |
|||
} else { |
|||
double stop = 3; |
|||
double root = sqrt(delta); |
|||
double sol = (b>0) ? (-b - root)/2.0 : (-b + root)/2.0; |
|||
x[0] = sol; |
|||
x[1] = c/sol; |
|||
// Check for root at start |
|||
} |
|||
if (value == 0) |
|||
Console.WriteLine("Root found at {0}", start); |
|||
for (var x = start + step; x <= stop; x += step) |
|||
{ |
|||
value = f(x); |
|||
if (((value > 0) ? 1 : 0) != sign) |
|||
// We passed a root |
|||
Console.WriteLine("Root found near {0}", x); |
|||
else if (value == 0) |
|||
// We hit a root |
|||
Console.WriteLine("Root found at {0}", x); |
|||
// Update our sign |
|||
sign = (value > 0) ? 1 : 0; |
|||
} |
|||
} |
|||
}</syntaxhighlight> |
}</syntaxhighlight> |
||
<syntaxhighlight lang="c">int main() |
|||
{{trans|Java}} |
|||
<syntaxhighlight lang="csharp">using System; |
|||
class Program |
|||
{ |
{ |
||
complex double x[2]; |
|||
{ |
|||
return x < 0.0 ? -1 : x > 0.0 ? 1 : 0; |
|||
} |
|||
roots_quadratic_eq(1, -1e20, 1, x); |
|||
public static void PrintRoots(Func<double, double> f, double lowerBound, |
|||
printf("x1 = (%.20le, %.20le)\nx2 = (%.20le, %.20le)\n\n", |
|||
double upperBound, double step) |
|||
creal(x[0]), cimag(x[0]), |
|||
{ |
|||
creal(x[1]), cimag(x[1])); |
|||
double x = lowerBound, ox = x; |
|||
roots_quadratic_eq2(1, -1e20, 1, x); |
|||
double y = f(x), oy = y; |
|||
printf("x1 = (%.20le, %.20le)\nx2 = (%.20le, %.20le)\n\n", |
|||
int s = Sign(y), os = s; |
|||
creal(x[0]), cimag(x[0]), |
|||
creal(x[1]), cimag(x[1])); |
|||
return 0; |
|||
for (; x <= upperBound; x += step) |
|||
}</syntaxhighlight> |
|||
{ |
|||
s = Sign(y = f(x)); |
|||
if (s == 0) |
|||
{ |
|||
Console.WriteLine(x); |
|||
} |
|||
else if (s != os) |
|||
{ |
|||
var dx = x - ox; |
|||
var dy = y - oy; |
|||
var cx = x - dx * (y / dy); |
|||
Console.WriteLine("~{0}", cx); |
|||
} |
|||
<pre>x1 = (1.00000000000000000000e+20, 0.00000000000000000000e+00) |
|||
ox = x; |
|||
x2 = (0.00000000000000000000e+00, 0.00000000000000000000e+00) |
|||
oy = y; |
|||
os = s; |
|||
} |
|||
} |
|||
x1 = (1.00000000000000000000e+20, 0.00000000000000000000e+00) |
|||
public static void Main(string[] args) |
|||
x2 = (9.99999999999999945153e-21, 0.00000000000000000000e+00)</pre> |
|||
{ |
|||
Func<double, double> f = x => { return x * x * x - 3 * x * x + 2 * x; }; |
|||
PrintRoots(f, -1.0, 4, 0.002); |
|||
} |
|||
}</syntaxhighlight> |
|||
=={{header|C sharp|C#}}== |
|||
===Brent's Method=== |
|||
{{trans|C++}} |
|||
<syntaxhighlight lang="csharp">using System; |
<syntaxhighlight lang="csharp">using System; |
||
using System.Numerics; |
|||
class |
class QuadraticRoots |
||
{ |
{ |
||
static Tuple<Complex, Complex> Solve(double a, double b, double c) |
|||
public static void Main(string[] args) |
|||
{ |
{ |
||
var q = -(b + Math.Sign(b) * Complex.Sqrt(b * b - 4 * a * c)) / 2; |
|||
return Tuple.Create(q / a, c / q); |
|||
} |
} |
||
static void Main() |
|||
{ |
{ |
||
Console.WriteLine(Solve(1, -1E20, 1)); |
|||
a = b; |
|||
b = tmp; |
|||
} |
} |
||
}</syntaxhighlight> |
|||
{{out}} |
|||
<pre>((1E+20, 0), (1E-20, 0))</pre> |
|||
=={{header|C++}}== |
|||
public static double BrentsFun(Func<double, double> f, double lower, double upper, double tol, uint maxIter) |
|||
<syntaxhighlight lang="cpp">#include <iostream> |
|||
{ |
|||
#include <utility> |
|||
double a = lower; |
|||
#include <complex> |
|||
double b = upper; |
|||
double fa = f(a); // calculated now to save function calls |
|||
double fb = f(b); // calculated now to save function calls |
|||
double fs; |
|||
typedef std::complex<double> complex; |
|||
if (!(fa * fb < 0)) |
|||
throw new ArgumentException("Signs of f(lower_bound) and f(upper_bound) must be opposites"); |
|||
std::pair<complex, complex> |
|||
if (Math.Abs(fa) < Math.Abs(b)) // if magnitude of f(lower_bound) is less than magnitude of f(upper_bound) |
|||
solve_quadratic_equation(double a, double b, double c) |
|||
{ |
|||
{ |
|||
Swap(ref a, ref b); |
|||
b /= a; |
|||
Swap(ref fa, ref fb); |
|||
c /= a; |
|||
double discriminant = b*b-4*c; |
|||
if (discriminant < 0) |
|||
return std::make_pair(complex(-b/2, std::sqrt(-discriminant)/2), |
|||
complex(-b/2, -std::sqrt(-discriminant)/2)); |
|||
double root = std::sqrt(discriminant); |
|||
double c = a; // c now equals the largest magnitude of the lower and upper bounds |
|||
double solution1 = (b > 0)? (-b - root)/2 |
|||
double fc = fa; // precompute function evalutation for point c by assigning it the same value as fa |
|||
: (-b + root)/2; |
|||
double s = 0; // Our Root that will be returned |
|||
double d = 0; // Only used if mflag is unset (mflag == false) |
|||
return std::make_pair(solution1, c/solution1); |
|||
for (uint iter = 1; iter < maxIter; ++iter) |
|||
{ |
|||
// stop if converged on root or error is less than tolerance |
|||
if (Math.Abs(b - a) < tol) |
|||
{ |
|||
Console.WriteLine("After {0} iterations the root is: {1}", iter, s); |
|||
return s; |
|||
} // end if |
|||
if (fa != fc && fb != fc) |
|||
{ |
|||
// use inverse quadratic interopolation |
|||
s = (a * fb * fc / ((fa - fb) * (fa - fc))) |
|||
+ (b * fa * fc / ((fb - fa) * (fb - fc))) |
|||
+ (c * fa * fb / ((fc - fa) * (fc - fb))); |
|||
} |
|||
else |
|||
{ |
|||
// secant method |
|||
s = b - fb * (b - a) / (fb - fa); |
|||
} |
|||
// checks to see whether we can use the faster converging quadratic && secant methods or if we need to use bisection |
|||
if ( ( (s < (3 * a + b) * 0.25) || (s > b)) || |
|||
( mflag && (Math.Abs(s - b) >= (Math.Abs(b - c) * 0.5)) ) || |
|||
( !mflag && (Math.Abs(s - b) >= (Math.Abs(c - d) * 0.5)) ) || |
|||
( mflag && (Math.Abs(b - c) < tol) ) || |
|||
( !mflag && (Math.Abs(c - d) < tol)) ) |
|||
{ |
|||
// bisection method |
|||
s = (a + b) * 0.5; |
|||
mflag = true; |
|||
} |
|||
else |
|||
{ |
|||
mflag = false; |
|||
} |
|||
fs = f(s);// calculate fs |
|||
d = c; // first time d is being used (wasnt used on first iteration because mflag was set) |
|||
c = b; // set c equal to upper bound |
|||
fc = fb; // set f(c) = f(b) |
|||
if (fa * fs < 0) // fa and fs have opposite signs |
|||
{ |
|||
b = s; |
|||
fb = fs; // set f(b) = f(s) |
|||
} |
|||
else |
|||
{ |
|||
a = s; |
|||
fa = fs; // set f(a) = f(s) |
|||
} |
|||
if (Math.Abs(fa) < Math.Abs(fb)) // if magnitude of fa is less than magnitude of fb |
|||
{ |
|||
Swap(ref a, ref b); // swap a and b |
|||
Swap(ref fa, ref fb); // make sure f(a) and f(b) are correct after swap |
|||
} |
|||
} // end for |
|||
throw new AggregateException("The solution does not converge or iterations are not sufficient"); |
|||
} |
|||
// end brents_fun |
|||
} |
|||
</syntaxhighlight> |
|||
=={{header|C++}}== |
|||
<syntaxhighlight lang="cpp">#include <iostream> |
|||
double f(double x) |
|||
{ |
|||
return (x*x*x - 3*x*x + 2*x); |
|||
} |
} |
||
int main() |
int main() |
||
{ |
{ |
||
std::pair<complex, complex> result = solve_quadratic_equation(1, -1e20, 1); |
|||
double step = 0.001; // Smaller step values produce more accurate and precise results |
|||
std::cout << result.first << ", " << result.second << std::endl; |
|||
double start = -1; |
|||
double stop = 3; |
|||
double value = f(start); |
|||
double sign = (value > 0); |
|||
// Check for root at start |
|||
if ( 0 == value ) |
|||
std::cout << "Root found at " << start << std::endl; |
|||
for( double x = start + step; |
|||
x <= stop; |
|||
x += step ) |
|||
{ |
|||
value = f(x); |
|||
if ( ( value > 0 ) != sign ) |
|||
// We passed a root |
|||
std::cout << "Root found near " << x << std::endl; |
|||
else if ( 0 == value ) |
|||
// We hit a root |
|||
std::cout << "Root found at " << x << std::endl; |
|||
// Update our sign |
|||
sign = ( value > 0 ); |
|||
} |
|||
}</syntaxhighlight> |
}</syntaxhighlight> |
||
{{out}} |
|||
(1e+20,0), (1e-20,0) |
|||
=={{header|Clojure}}== |
|||
===Brent's Method=== |
|||
Brent's Method uses a combination of the bisection method, inverse quadratic interpolation, and the secant method to find roots. It has a guaranteed run time equal to that of the bisection method (which always converges in a known number of steps (log2[(upper_bound-lower_bound)/tolerance] steps to be precise ) unlike the other methods), but the algorithm uses the much faster inverse quadratic interpolation and secant method whenever possible. The algorithm is robust and commonly used in libraries with a roots() function built in. |
|||
<syntaxhighlight lang="clojure">(defn quadratic |
|||
The algorithm is coded as a function that returns a double value for the root. The function takes an input that requires the function being evaluated, the lower and upper bounds, the tolerance one is looking for before converging (i recommend 0.0001) and the maximum number of iterations before giving up on finding the root (the root will always be found if the root is bracketed and a sufficient number of iterations is allowed). |
|||
"Compute the roots of a quadratic in the form ax^2 + bx + c = 1. |
|||
Returns any of nil, a float, or a vector." |
|||
[a b c] |
|||
(let [sq-d (Math/sqrt (- (* b b) (* 4 a c))) |
|||
f #(/ (% b sq-d) (* 2 a))] |
|||
(cond |
|||
(neg? sq-d) nil |
|||
(zero? sq-d) (f +) |
|||
(pos? sq-d) [(f +) (f -)] |
|||
:else nil))) ; maybe our number ended up as NaN</syntaxhighlight> |
|||
{{out}} |
|||
The implementation is taken from the pseudo code on the wikipedia page for Brent's Method found here: https://en.wikipedia.org/wiki/Brent%27s_method. |
|||
<syntaxhighlight lang=" |
<syntaxhighlight lang="clojure">user=> (quadratic 1.0 1.0 1.0) |
||
nil |
|||
#include <cmath> |
|||
user=> (quadratic 1.0 2.0 1.0) |
|||
#include <algorithm> |
|||
1.0 |
|||
#include <functional> |
|||
user=> (quadratic 1.0 3.0 1.0) |
|||
[2.618033988749895 0.3819660112501051] |
|||
</syntaxhighlight> |
|||
=={{header|Common Lisp}}== |
|||
double brents_fun(std::function<double (double)> f, double lower, double upper, double tol, unsigned int max_iter) |
|||
<syntaxhighlight lang="lisp">(defun quadratic (a b c) |
|||
{ |
|||
(list |
|||
double a = lower; |
|||
(/ (+ (- b) (sqrt (- (expt b 2) (* 4 a c)))) (* 2 a)) |
|||
double b = upper; |
|||
(/ (- (- b) (sqrt (- (expt b 2) (* 4 a c)))) (* 2 a))))</syntaxhighlight> |
|||
double fa = f(a); // calculated now to save function calls |
|||
double fb = f(b); // calculated now to save function calls |
|||
double fs = 0; // initialize |
|||
=={{header|D}}== |
|||
if (!(fa * fb < 0)) |
|||
<syntaxhighlight lang="d">import std.math, std.traits; |
|||
{ |
|||
std::cout << "Signs of f(lower_bound) and f(upper_bound) must be opposites" << std::endl; // throws exception if root isn't bracketed |
|||
return -11; |
|||
} |
|||
CommonType!(T1, T2, T3)[] naiveQR(T1, T2, T3) |
|||
if (std::abs(fa) < std::abs(b)) // if magnitude of f(lower_bound) is less than magnitude of f(upper_bound) |
|||
(in T1 a, in T2 b, in T3 c) |
|||
{ |
|||
pure nothrow if (isFloatingPoint!T1) { |
|||
std::swap(a,b); |
|||
alias ReturnT = typeof(typeof(return).init[0]); |
|||
std::swap(fa,fb); |
|||
if (a == 0) |
|||
} |
|||
return [ReturnT(c / b)]; // It's a linear function. |
|||
immutable ReturnT det = b ^^ 2 - 4 * a * c; |
|||
if (det < 0) |
|||
return []; // No real number root. |
|||
immutable SD = sqrt(det); |
|||
return [(-b + SD) / 2 * a, (-b - SD) / 2 * a]; |
|||
} |
|||
CommonType!(T1, T2, T3)[] cautiQR(T1, T2, T3) |
|||
double c = a; // c now equals the largest magnitude of the lower and upper bounds |
|||
(in T1 a, in T2 b, in T3 c) |
|||
double fc = fa; // precompute function evalutation for point c by assigning it the same value as fa |
|||
pure nothrow if (isFloatingPoint!T1) { |
|||
bool mflag = true; // boolean flag used to evaluate if statement later on |
|||
alias ReturnT = typeof(typeof(return).init[0]); |
|||
double s = 0; // Our Root that will be returned |
|||
if (a == 0) |
|||
return [ReturnT(c / b)]; // It's a linear function. |
|||
immutable ReturnT det = b ^^ 2 - 4 * a * c; |
|||
if (det < 0) |
|||
return []; // No real number root. |
|||
immutable SD = sqrt(det); |
|||
if (b * a < 0) { |
|||
for (unsigned int iter = 1; iter < max_iter; ++iter) |
|||
immutable x = (-b + SD) / 2 * a; |
|||
{ |
|||
return [x, c / (a * x)]; |
|||
// stop if converged on root or error is less than tolerance |
|||
} else { |
|||
if (std::abs(b-a) < tol) |
|||
immutable x = (-b - SD) / 2 * a; |
|||
{ |
|||
return [c / (a * x), x]; |
|||
std::cout << "After " << iter << " iterations the root is: " << s << std::endl; |
|||
} |
|||
return s; |
|||
} |
|||
} // end if |
|||
if (fa != fc && fb != fc) |
|||
{ |
|||
// use inverse quadratic interopolation |
|||
s = ( a * fb * fc / ((fa - fb) * (fa - fc)) ) |
|||
+ ( b * fa * fc / ((fb - fa) * (fb - fc)) ) |
|||
+ ( c * fa * fb / ((fc - fa) * (fc - fb)) ); |
|||
} |
|||
else |
|||
{ |
|||
// secant method |
|||
s = b - fb * (b - a) / (fb - fa); |
|||
} |
|||
void main() { |
|||
// checks to see whether we can use the faster converging quadratic && secant methods or if we need to use bisection |
|||
import std.stdio; |
|||
if ( ( (s < (3 * a + b) * 0.25) || (s > b) ) || |
|||
writeln("With 32 bit float type:"); |
|||
( mflag && (std::abs(s-b) >= (std::abs(b-c) * 0.5)) ) || |
|||
writefln(" Naive: [%(%g, %)]", naiveQR(1.0f, -10e5f, 1.0f)); |
|||
( !mflag && (std::abs(s-b) >= (std::abs(c-d) * 0.5)) ) || |
|||
writefln("Cautious: [%(%g, %)]", cautiQR(1.0f, -10e5f, 1.0f)); |
|||
( mflag && (std::abs(b-c) < tol) ) || |
|||
writeln("\nWith 64 bit double type:"); |
|||
( !mflag && (std::abs(c-d) < tol)) ) |
|||
writefln(" Naive: [%(%g, %)]", naiveQR(1.0, -10e5, 1.0)); |
|||
{ |
|||
writefln("Cautious: [%(%g, %)]", cautiQR(1.0, -10e5, 1.0)); |
|||
// bisection method |
|||
writeln("\nWith real type:"); |
|||
s = (a+b)*0.5; |
|||
writefln(" Naive: [%(%g, %)]", naiveQR(1.0L, -10e5L, 1.0L)); |
|||
writefln("Cautious: [%(%g, %)]", cautiQR(1.0L, -10e5L, 1.0L)); |
|||
}</syntaxhighlight> |
|||
{{out}} |
|||
<pre>With 32 bit float type: |
|||
Naive: [1e+06, 0] |
|||
Cautious: [1e+06, 1e-06] |
|||
With 64 bit double type: |
|||
mflag = true; |
|||
Naive: [1e+06, 1.00001e-06] |
|||
} |
|||
Cautious: [1e+06, 1e-06] |
|||
else |
|||
{ |
|||
mflag = false; |
|||
} |
|||
With real type: |
|||
fs = f(s); // calculate fs |
|||
Naive: [1e+06, 1e-06] |
|||
d = c; // first time d is being used (wasnt used on first iteration because mflag was set) |
|||
Cautious: [1e+06, 1e-06]</pre> |
|||
c = b; // set c equal to upper bound |
|||
fc = fb; // set f(c) = f(b) |
|||
=={{header|Delphi}}== |
|||
if ( fa * fs < 0) // fa and fs have opposite signs |
|||
See [https://rosettacode.org/wiki/Roots_of_a_quadratic_function#Pascal Pascal]. |
|||
{ |
|||
b = s; |
|||
fb = fs; // set f(b) = f(s) |
|||
} |
|||
else |
|||
{ |
|||
a = s; |
|||
fa = fs; // set f(a) = f(s) |
|||
} |
|||
=={{header|Elixir}}== |
|||
if (std::abs(fa) < std::abs(fb)) // if magnitude of fa is less than magnitude of fb |
|||
<syntaxhighlight lang="elixir">defmodule Quadratic do |
|||
{ |
|||
def roots(a, b, c) do |
|||
std::swap(a,b); // swap a and b |
|||
IO.puts "Roots of a quadratic function (#{a}, #{b}, #{c})" |
|||
std::swap(fa,fb); // make sure f(a) and f(b) are correct after swap |
|||
d = b * b - 4 * a * c |
|||
} |
|||
a2 = a * 2 |
|||
cond do |
|||
d > 0 -> |
|||
sd = :math.sqrt(d) |
|||
IO.puts " the real roots are #{(- b + sd) / a2} and #{(- b - sd) / a2}" |
|||
d == 0 -> |
|||
IO.puts " the single root is #{- b / a2}" |
|||
true -> |
|||
sd = :math.sqrt(-d) |
|||
IO.puts " the complex roots are #{- b / a2} +/- #{sd / a2}*i" |
|||
end |
|||
end |
|||
end |
|||
Quadratic.roots(1, -2, 1) |
|||
} // end for |
|||
Quadratic.roots(1, -3, 2) |
|||
Quadratic.roots(1, 0, 1) |
|||
Quadratic.roots(1, -1.0e10, 1) |
|||
Quadratic.roots(1, 2, 3) |
|||
Quadratic.roots(2, -1, -6)</syntaxhighlight> |
|||
{{out}} |
|||
std::cout<< "The solution does not converge or iterations are not sufficient" << std::endl; |
|||
<pre> |
|||
Roots of a quadratic function (1, -2, 1) |
|||
the single root is 1.0 |
|||
Roots of a quadratic function (1, -3, 2) |
|||
the real roots are 2.0 and 1.0 |
|||
Roots of a quadratic function (1, 0, 1) |
|||
the complex roots are 0.0 +/- 1.0*i |
|||
Roots of a quadratic function (1, -1.0e10, 1) |
|||
the real roots are 1.0e10 and 0.0 |
|||
Roots of a quadratic function (1, 2, 3) |
|||
the complex roots are -1.0 +/- 1.4142135623730951*i |
|||
Roots of a quadratic function (2, -1, -6) |
|||
the real roots are 2.0 and -1.5 |
|||
</pre> |
|||
=={{header|ERRE}}== |
|||
} // end brents_fun |
|||
<syntaxhighlight lang="text">PROGRAM QUADRATIC |
|||
PROCEDURE SOLVE_QUADRATIC |
|||
</syntaxhighlight> |
|||
D=B*B-4*A*C |
|||
IF ABS(D)<1D-6 THEN D=0 END IF |
|||
CASE SGN(D) OF |
|||
0-> |
|||
PRINT("the single root is ";-B/2/A) |
|||
END -> |
|||
1-> |
|||
F=(1+SQR(1-4*A*C/(B*B)))/2 |
|||
PRINT("the real roots are ";-F*B/A;"and ";-C/B/F) |
|||
END -> |
|||
-1-> |
|||
PRINT("the complex roots are ";-B/2/A;"+/-";SQR(-D)/2/A;"*i") |
|||
END -> |
|||
END CASE |
|||
END PROCEDURE |
|||
BEGIN |
|||
=={{header|Clojure}}== |
|||
PRINT(CHR$(12);) ! CLS |
|||
FOR TEST%=1 TO 7 DO |
|||
{{trans|Haskell}} |
|||
READ(A,B,C) |
|||
<syntaxhighlight lang="clojure"> |
|||
PRINT("For a=";A;",b=";B;",c=";C;TAB(32);) |
|||
SOLVE_QUADRATIC |
|||
(defn findRoots [f start stop step eps] |
|||
END FOR |
|||
(filter #(-> (f %) Math/abs (< eps)) (range start stop step))) |
|||
DATA(1,-1E9,1) |
|||
</syntaxhighlight> |
|||
DATA(1,0,1) |
|||
DATA(2,-1,-6) |
|||
<pre> |
|||
DATA(1,2,-2) |
|||
> (findRoots #(+ (* % % %) (* -3 % %) (* 2 %)) -1.0 3.0 0.0001 0.00000001) |
|||
DATA(0.5,1.4142135,1) |
|||
(-9.381755897326649E-14 0.9999999999998124 1.9999999999997022) |
|||
DATA(1,3,2) |
|||
DATA(3,4,5) |
|||
END PROGRAM</syntaxhighlight> |
|||
{{out}} |
|||
<pre>For a= 1 ,b=-1E+09 ,c= 1 the real roots are 1E+09 and 1E-09 |
|||
For a= 1 ,b= 0 ,c= 1 the complex roots are 0 +/- 1 *i |
|||
For a= 2 ,b=-1 ,c=-6 the real roots are 2 and -1.5 |
|||
For a= 1 ,b= 2 ,c=-2 the real roots are -2.732051 and .7320508 |
|||
For a= .5 ,b= 1.414214 ,c= 1 the single root is -1.414214 |
|||
For a= 1 ,b= 3 ,c= 2 the real roots are -2 and -1 |
|||
For a= 3 ,b= 4 ,c= 5 the complex roots are -.6666667 +/- 1.105542 *i |
|||
</pre> |
</pre> |
||
=={{header| |
=={{header|Factor}}== |
||
{{trans| |
{{trans|Ada}} |
||
<syntaxhighlight lang=" |
<syntaxhighlight lang="factor">:: quadratic-equation ( a b c -- x1 x2 ) |
||
b sq a c * 4 * - sqrt :> sd |
|||
print_roots = (f, begin, end, step) -> |
|||
b 0 < |
|||
# Print approximate roots of f between x=begin and x=end, |
|||
[ b neg sd + a 2 * / ] |
|||
[ b neg sd - a 2 * / ] if :> x |
|||
# encountered. |
|||
x c a x * / ;</syntaxhighlight> |
|||
x = begin |
|||
y = f(x) |
|||
last_y = y |
|||
cross_x_axis = -> |
|||
(last_y < 0 and y > 0) or (last_y > 0 and y < 0) |
|||
console.log '-----' |
|||
while x <= end |
|||
y = f(x) |
|||
if y == 0 |
|||
console.log "Root found at", x |
|||
else if cross_x_axis() |
|||
console.log "Root found near", x |
|||
x += step |
|||
last_y = y |
|||
<syntaxhighlight lang="factor">( scratchpad ) 1 -1.e20 1 quadratic-equation |
|||
do -> |
|||
--- Data stack: |
|||
# Smaller steps produce more accurate/precise results in general, |
|||
1.0e+20 |
|||
# but for many functions we'll never get exact roots, either due |
|||
9.999999999999999e-21</syntaxhighlight> |
|||
# to imperfect binary representation or irrational roots. |
|||
step = 1 / 256 |
|||
Middlebrook method |
|||
f1 = (x) -> x*x*x - 3*x*x + 2*x |
|||
<syntaxhighlight lang="factor">:: quadratic-equation2 ( a b c -- x1 x2 ) |
|||
print_roots f1, -1, 5, step |
|||
a c * sqrt b / :> q |
|||
1 4 q sq * - sqrt 0.5 * 0.5 + :> f |
|||
print_roots f2, -1, 5, step |
|||
b neg a / f * c neg b / f / ; |
|||
print_roots f3, 0, 4, step |
|||
f4 = (x) -> x*x - 2 |
|||
print_roots f4, -2, 2, step |
|||
</syntaxhighlight> |
</syntaxhighlight> |
||
output |
|||
<syntaxhighlight lang=" |
<syntaxhighlight lang="factor">( scratchpad ) 1 -1.e20 1 quadratic-equation |
||
--- Data stack: |
|||
> coffee roots.coffee |
|||
1.0e+20 |
|||
----- |
|||
1.0e-20</syntaxhighlight> |
|||
Root found at 0 |
|||
Root found at 1 |
|||
Root found at 2 |
|||
----- |
|||
Root found at 1 |
|||
Root found at 3 |
|||
----- |
|||
Root found at 1.5 |
|||
----- |
|||
Root found near -1.4140625 |
|||
Root found near 1.41796875 |
|||
</syntaxhighlight> |
|||
=={{header| |
=={{header|Forth}}== |
||
Without locals: |
|||
<syntaxhighlight lang="forth">: quadratic ( fa fb fc -- r1 r2 ) |
|||
frot frot |
|||
( c a b ) |
|||
fover 3 fpick f* -4e f* fover fdup f* f+ |
|||
( c a b det ) |
|||
fdup f0< if abort" imaginary roots" then |
|||
fsqrt |
|||
fover f0< if fnegate then |
|||
f+ fnegate |
|||
( c a b-det ) |
|||
2e f/ fover f/ |
|||
( c a r1 ) |
|||
frot frot f/ fover f/ ;</syntaxhighlight> |
|||
With locals: |
|||
<syntaxhighlight lang="forth">: quadratic { F: a F: b F: c -- r1 r2 } |
|||
b b f* 4e a f* c f* f- |
|||
fdup f0< if abort" imaginary roots" then |
|||
fsqrt |
|||
b f0< if fnegate then b f+ fnegate 2e f/ a f/ |
|||
c a f/ fover f/ ; |
|||
\ test |
|||
{{trans|Perl}} |
|||
1 set-precision |
|||
1e -1e6 1e quadratic fs. fs. \ 1e-6 1e6</syntaxhighlight> |
|||
=={{header|Fortran}}== |
|||
<code>find-roots</code> prints roots (and values near roots) and returns a list of root designators, each of which is either a number <code><var>n</var></code>, in which case <code>(zerop (funcall function <var>n</var>))</code> is true, or a <code>cons</code> whose <code>car</code> and <code>cdr</code> are such that the sign of function at car and cdr changes. |
|||
===Fortran 90=== |
|||
{{works with|Fortran|90 and later}} |
|||
<syntaxhighlight lang="fortran">PROGRAM QUADRATIC |
|||
IMPLICIT NONE |
|||
<syntaxhighlight lang="lisp">(defun find-roots (function start end &optional (step 0.0001)) |
|||
INTEGER, PARAMETER :: dp = SELECTED_REAL_KIND(15) |
|||
(let* ((roots '()) |
|||
REAL(dp) :: a, b, c, e, discriminant, rroot1, rroot2 |
|||
(value (funcall function start)) |
|||
COMPLEX(dp) :: croot1, croot2 |
|||
(plusp (plusp value))) |
|||
(when (zerop value) |
|||
(format t "~&Root found at ~W." start)) |
|||
(do ((x (+ start step) (+ x step))) |
|||
((> x end) (nreverse roots)) |
|||
(setf value (funcall function x)) |
|||
(cond |
|||
((zerop value) |
|||
(format t "~&Root found at ~w." x) |
|||
(push x roots)) |
|||
((not (eql plusp (plusp value))) |
|||
(format t "~&Root found near ~w." x) |
|||
(push (cons (- x step) x) roots))) |
|||
(setf plusp (plusp value)))))</syntaxhighlight> |
|||
WRITE(*,*) "Enter the coefficients of the equation ax^2 + bx + c" |
|||
<pre>> (find-roots #'(lambda (x) (+ (* x x x) (* -3 x x) (* 2 x))) -1 3) |
|||
WRITE(*, "(A)", ADVANCE="NO") "a = " |
|||
Root found near 5.3588345E-5. |
|||
READ *, a |
|||
Root found near 1.0000072. |
|||
WRITE(*,"(A)", ADVANCE="NO") "b = " |
|||
Root found near 2.000073. |
|||
READ *, b |
|||
((-4.6411653E-5 . 5.3588345E-5) |
|||
WRITE(*,"(A)", ADVANCE="NO") "c = " |
|||
(0.99990714 . 1.0000072) |
|||
READ *, c |
|||
(1.9999729 . 2.000073))</pre> |
|||
WRITE(*,"(3(A,E23.15))") "Coefficients are: a = ", a, " b = ", b, " c = ", c |
|||
e = 1.0e-9_dp |
|||
discriminant = b*b - 4.0_dp*a*c |
|||
IF (ABS(discriminant) < e) THEN |
|||
rroot1 = -b / (2.0_dp * a) |
|||
WRITE(*,*) "The roots are real and equal:" |
|||
WRITE(*,"(A,E23.15)") "Root = ", rroot1 |
|||
ELSE IF (discriminant > 0) THEN |
|||
rroot1 = -(b + SIGN(SQRT(discriminant), b)) / (2.0_dp * a) |
|||
rroot2 = c / (a * rroot1) |
|||
WRITE(*,*) "The roots are real:" |
|||
WRITE(*,"(2(A,E23.15))") "Root1 = ", rroot1, " Root2 = ", rroot2 |
|||
ELSE |
|||
croot1 = (-b + SQRT(CMPLX(discriminant))) / (2.0_dp*a) |
|||
croot2 = CONJG(croot1) |
|||
WRITE(*,*) "The roots are complex:" |
|||
WRITE(*,"(2(A,2E23.15,A))") "Root1 = ", croot1, "j ", " Root2 = ", croot2, "j" |
|||
END IF</syntaxhighlight> |
|||
{{out}} |
|||
Coefficients are: a = 0.300000000000000E+01 b = 0.400000000000000E+01 c = 0.133333333330000E+01 |
|||
The roots are real and equal: |
|||
Root = -0.666666666666667E+00 |
|||
Coefficients are: a = 0.300000000000000E+01 b = 0.200000000000000E+01 c = -0.100000000000000E+01 |
|||
The roots are real: |
|||
Root1 = -0.100000000000000E+01 Root2 = 0.333333333333333E+00 |
|||
Coefficients are: a = 0.300000000000000E+01 b = 0.200000000000000E+01 c = 0.100000000000000E+01 |
|||
The roots are complex: |
|||
Root1 = -0.333333333333333E+00 0.471404512723287E+00j Root2 = -0.333333333333333E+00 -0.471404512723287E+00j |
|||
Coefficients are: a = 0.100000000000000E+01 b = -0.100000000000000E+07 c = 0.100000000000000E+01 |
|||
The roots are real: |
|||
Root1 = 0.999999999999000E+06 Root2 = 0.100000000000100E-05 |
|||
== |
===Fortran I=== |
||
Source code written in FORTRAN I (october 1956) for the IBM 704. |
|||
<syntaxhighlight lang="d">import std.stdio, std.math, std.algorithm; |
|||
<syntaxhighlight lang="fortran"> |
|||
COMPUTE ROOTS OF A QUADRATIC FUNCTION - 1956 |
|||
READ 100,A,B,C |
|||
100 FORMAT(3F8.3) |
|||
PRINT 100,A,B,C |
|||
DISC=B**2-4.*A*C |
|||
IF(DISC),1,2,3 |
|||
1 XR=-B/(2.*A) |
|||
XI=SQRT(-DISC)/(2.*A) |
|||
XJ=-XI |
|||
PRINT 311 |
|||
PRINT 312,XR,XI,XR,XJ |
|||
311 FORMAT(13HCOMPLEX ROOTS) |
|||
312 FORMAT(4HX1=(,2E12.4,6H),X2=(,2E12.4,1H)) |
|||
GO TO 999 |
|||
2 X1=-B/(2.*A) |
|||
X2=X1 |
|||
PRINT 321 |
|||
PRINT 332,X1,X2 |
|||
321 FORMAT(16HEQUAL REAL ROOTS) |
|||
GO TO 999 |
|||
3 X1= (-B+SQRT(DISC)) / (2.*A) |
|||
X2= (-B-SQRT(DISC)) / (2.*A) |
|||
PRINT 331 |
|||
PRINT 332,X1,X2 |
|||
331 FORMAT(10HREAL ROOTS) |
|||
332 FORMAT(3HX1=,E12.5,4H,X2=,E12.5) |
|||
999 STOP |
|||
</syntaxhighlight> |
|||
=={{header|FreeBASIC}}== |
|||
bool nearZero(T)(in T a, in T b = T.epsilon * 4) pure nothrow { |
|||
{{libheader|GMP}} |
|||
return abs(a) <= b; |
|||
<syntaxhighlight lang="freebasic">' version 20-12-2020 |
|||
} |
|||
' compile with: fbc -s console |
|||
#Include Once "gmp.bi" |
|||
T[] findRoot(T)(immutable T function(in T) pure nothrow fi, |
|||
in T start, in T end, in T step=T(0.001L), |
|||
T tolerance = T(1e-4L)) { |
|||
if (step.nearZero) |
|||
writefln("WARNING: step size may be too small."); |
|||
Sub solvequadratic_n(a As Double ,b As Double, c As Double) |
|||
/// Search root by simple bisection. |
|||
T searchRoot(T a, T b) pure nothrow { |
|||
T root; |
|||
int limit = 49; |
|||
T gap = b - a; |
|||
Dim As Double f, d = b ^ 2 - 4 * a * c |
|||
while (!nearZero(gap) && limit--) { |
|||
if (fi(a).nearZero) |
|||
return a; |
|||
if (fi(b).nearZero) |
|||
return b; |
|||
root = (b + a) / 2.0L; |
|||
if (fi(root).nearZero) |
|||
return root; |
|||
((fi(a) * fi(root) < 0) ? b : a) = root; |
|||
gap = b - a; |
|||
} |
|||
Select Case Sgn(d) |
|||
return root; |
|||
Case 0 |
|||
Print "1: the single root is "; -b / 2 / a |
|||
Case 1 |
|||
Print "1: the real roots are "; (-b + Sqr(d)) / 2 * a; " and ";(-b - Sqr(d)) / 2 * a |
|||
Case -1 |
|||
Print "1: the complex roots are "; -b / 2 / a; " +/- "; Sqr(-d) / 2 / a; "*i" |
|||
End Select |
|||
End Sub |
|||
immutable dir = T(end > start ? 1.0 : -1.0); |
|||
immutable step2 = (end > start) ? abs(step) : -abs(step); |
|||
T[T] result; |
|||
for (T x = start; (x * dir) <= (end * dir); x += step2) |
|||
if (fi(x) * fi(x + step2) <= 0) { |
|||
immutable T r = searchRoot(x, x + step2); |
|||
result[r] = fi(r); |
|||
} |
|||
Sub solvequadratic_c(a As Double ,b As Double, c As Double) |
|||
return result.keys.sort().release; |
|||
} |
|||
Dim As Double f, d = b ^ 2 - 4 * a * c |
|||
void report(T)(in T[] r, immutable T function(in T) pure f, |
|||
Select Case Sgn(d) |
|||
in T tolerance = T(1e-4L)) { |
|||
Case 0 |
|||
Print "2: the single root is "; -b / 2 / a |
|||
writefln("Root found (tolerance = %1.4g):", tolerance); |
|||
Case 1 |
|||
f = (1 + Sqr(1 - 4 * a *c / b ^ 2)) / 2 |
|||
Print "2: the real roots are "; -f * b / a; " and "; -c / b / f |
|||
Case -1 |
|||
Print "2: the complex roots are "; -b / 2 / a; " +/- "; Sqr(-d) / 2 / a; "*i" |
|||
End Select |
|||
End Sub |
|||
Sub solvequadratic_gmp(a_ As Double ,b_ As Double, c_ As Double) |
|||
foreach (const x; r) { |
|||
immutable T y = f(x); |
|||
#Define PRECISION 1024 ' about 300 digits |
|||
if (nearZero(y)) |
|||
#Define MAX 25 |
|||
writefln("... EXACTLY at %+1.20f, f(x) = %+1.4g",x,y); |
|||
else if (nearZero(y, tolerance)) |
|||
writefln(".... MAY-BE at %+1.20f, f(x) = %+1.4g",x,y); |
|||
else |
|||
writefln("Verify needed, f(%1.4g) = " ~ |
|||
"%1.4g > tolerance in magnitude", x, y); |
|||
} |
|||
} else |
|||
writefln("No root found."); |
|||
} |
|||
Dim As ZString Ptr text |
|||
void main() { |
|||
text = Callocate (1000) |
|||
static real f(in real x) pure nothrow { |
|||
Mpf_set_default_prec(PRECISION) |
|||
return x ^^ 3 - (3 * x ^^ 2) + 2 * x; |
|||
} |
|||
Dim As Mpf_ptr a, b, c, d, t |
|||
findRoot(&f, -1.0L, 3.0L, 0.001L).report(&f); |
|||
a = Allocate(Len(__mpf_struct)) : Mpf_init_set_d(a, a_) |
|||
}</syntaxhighlight> |
|||
b = Allocate(Len(__mpf_struct)) : Mpf_init_set_d(b, b_) |
|||
{{out}} |
|||
c = Allocate(Len(__mpf_struct)) : Mpf_init_set_d(c, c_) |
|||
<pre>Root found (tolerance = 0.0001): |
|||
d = Allocate(Len(__mpf_struct)) : Mpf_init(d) |
|||
.... MAY-BE at -0.00000000000000000080, f(x) = -1.603e-18 |
|||
t = Allocate(Len(__mpf_struct)) : Mpf_init(t) |
|||
... EXACTLY at +1.00000000000000000020, f(x) = -2.168e-19 |
|||
.... MAY-BE at +1.99999999999999999950, f(x) = -8.674e-19</pre> |
|||
NB: smallest increment for real type in D is real.epsilon = 1.0842e-19. |
|||
mpf_mul(d, b, b) |
|||
=={{header|Dart}}== |
|||
mpf_set_ui(t, 4) |
|||
{{trans|Scala}} |
|||
mpf_mul(t, t, a) |
|||
<syntaxhighlight lang="dart">double fn(double x) => x * x * x - 3 * x * x + 2 * x; |
|||
mpf_mul(t, t, c) |
|||
mpf_sub(d, d, t) |
|||
Select Case mpf_sgn(d) |
|||
findRoots(Function(double) f, double start, double stop, double step, double epsilon) sync* { |
|||
Case 0 |
|||
for (double x = start; x < stop; x = x + step) { |
|||
mpf_neg(t, b) |
|||
if (fn(x).abs() < epsilon) yield x; |
|||
mpf_div_ui(t, t, 2) |
|||
} |
|||
mpf_div(t, t, a) |
|||
} |
|||
Gmp_sprintf(text,"%.*Fe", MAX, t) |
|||
Print "3: the single root is "; *text |
|||
Case Is > 0 |
|||
mpf_sqrt(d, d) |
|||
mpf_add(a, a, a) |
|||
mpf_neg(t, b) |
|||
mpf_add(t, t, d) |
|||
mpf_div(t, t, a) |
|||
Gmp_sprintf(text,"%.*Fe", MAX, t) |
|||
Print "3: the real roots are "; *text; " and "; |
|||
mpf_neg(t, b) |
|||
mpf_sub(t, t, d) |
|||
mpf_div(t, t, a) |
|||
Gmp_sprintf(text,"%.*Fe", MAX, t) |
|||
Print *text |
|||
Case Is < 0 |
|||
mpf_neg(t, b) |
|||
mpf_div_ui(t, t, 2) |
|||
mpf_div(t, t, a) |
|||
Gmp_sprintf(text,"%.*Fe", MAX, t) |
|||
Print "3: the complex roots are "; *text; " +/- "; |
|||
mpf_neg(t, d) |
|||
mpf_sqrt(t, t) |
|||
mpf_div_ui(t, t, 2) |
|||
mpf_div(t, t, a) |
|||
Gmp_sprintf(text,"%.*Fe", MAX, t) |
|||
Print *text; "*i" |
|||
End Select |
|||
End Sub |
|||
main() { |
|||
// Vector(-9.381755897326649E-14, 0.9999999999998124, 1.9999999999997022) |
|||
print(findRoots(fn, -1.0, 3.0, 0.0001, 0.000000001)); |
|||
}</syntaxhighlight> |
|||
' ------=< MAIN >=------ |
|||
=={{header|Delphi}}== |
|||
See [https://rosettacode.org/wiki/Roots_of_a_function#Pascal Pascal]. |
|||
Dim As Double a, b, c |
|||
=={{header|DWScript}}== |
|||
Print "1: is the naieve way" |
|||
{{trans|C}} |
|||
Print "2: is the cautious way" |
|||
<syntaxhighlight lang="delphi">type TFunc = function (x : Float) : Float; |
|||
Print "3: is the naieve way with help of GMP" |
|||
Print |
|||
For i As Integer = 1 To 10 |
|||
function f(x : Float) : Float; |
|||
Read a, b, c |
|||
begin |
|||
Print "Find root(s) for "; Str(a); "X^2"; IIf(b < 0, "", "+"); |
|||
Result := x*x*x-3.0*x*x +2.0*x; |
|||
Print Str(b); "X"; IIf(c < 0, "", "+"); Str(c) |
|||
end; |
|||
solvequadratic_n(a, b , c) |
|||
solvequadratic_c(a, b , c) |
|||
solvequadratic_gmp(a, b , c) |
|||
Print |
|||
Next |
|||
' empty keyboard buffer |
|||
const e = 1.0e-12; |
|||
While Inkey <> "" : Wend |
|||
Print : Print "hit any key to end program" |
|||
function Secant(xA, xB : Float; f : TFunc) : Float; |
|||
Sleep |
|||
const |
|||
End |
|||
limit = 50; |
|||
var |
|||
fA, fB : Float; |
|||
d : Float; |
|||
i : Integer; |
|||
begin |
|||
fA := f(xA); |
|||
for i := 0 to limit do begin |
|||
fB := f(xB); |
|||
d := (xB-xA)/(fB-fA)*fB; |
|||
if Abs(d) < e then |
|||
Exit(xB); |
|||
xA := xB; |
|||
fA := fB; |
|||
xB -= d; |
|||
end; |
|||
PrintLn(Format('Function is not converging near (%7.4f,%7.4f).', [xA, xB])); |
|||
Result := -99.0; |
|||
end; |
|||
const fstep = 1.0e-2; |
|||
var x := -1.032; // just so we use secant method |
|||
var xx, value : Float; |
|||
var s := f(x)>0.0; |
|||
while (x < 3.0) do begin |
|||
value := f(x); |
|||
if Abs(value)<e then begin |
|||
PrintLn(Format("Root found at x= %12.9f", [x])); |
|||
s := (f(x+0.0001)>0.0); |
|||
end else if (value>0.0) <> s then begin |
|||
xx := Secant(x-fstep, x, f); |
|||
if xx <> -99.0 then // -99 meaning secand method failed |
|||
PrintLn(Format('Root found at x = %12.9f', [xx])) |
|||
else PrintLn(Format('Root found near x= %7.4f', [xx])); |
|||
s := (f(x+0.0001)>0.0); |
|||
end; |
|||
x += fstep; |
|||
end;</syntaxhighlight> |
|||
=={{header|EchoLisp}}== |
|||
We use the 'math' library, and define f(x) as the polynomial : x<sup>3</sup> -3x<sup>2</sup> +2x |
|||
<syntaxhighlight lang="lisp"> |
|||
(lib 'math.lib) |
|||
Lib: math.lib loaded. |
|||
(define fp ' ( 0 2 -3 1)) |
|||
(poly->string 'x fp) → x^3 -3x^2 +2x |
|||
(poly->html 'x fp) → x<sup>3</sup> -3x<sup>2</sup> +2x |
|||
(define (f x) (poly x fp)) |
|||
(math-precision 1.e-6) → 0.000001 |
|||
(root f -1000 1000) → 2.0000000133245677 ;; 2 |
|||
(root f -1000 (- 2 epsilon)) → 1.385559938161431e-7 ;; 0 |
|||
(root f epsilon (- 2 epsilon)) → 1.0000000002190812 ;; 1 |
|||
</syntaxhighlight> |
|||
=={{header|Elixir}}== |
|||
{{trans|Ruby}} |
|||
<syntaxhighlight lang="elixir">defmodule RC do |
|||
def find_roots(f, range, step \\ 0.001) do |
|||
first .. last = range |
|||
max = last + step / 2 |
|||
Stream.iterate(first, &(&1 + step)) |
|||
|> Stream.take_while(&(&1 < max)) |
|||
|> Enum.reduce(sign(first), fn x,sn -> |
|||
value = f.(x) |
|||
cond do |
|||
abs(value) < step / 100 -> |
|||
IO.puts "Root found at #{x}" |
|||
0 |
|||
sign(value) == -sn -> |
|||
IO.puts "Root found between #{x-step} and #{x}" |
|||
-sn |
|||
true -> sign(value) |
|||
end |
|||
end) |
|||
end |
|||
defp sign(x) when x>0, do: 1 |
|||
defp sign(x) when x<0, do: -1 |
|||
defp sign(0) , do: 0 |
|||
end |
|||
f = fn x -> x*x*x - 3*x*x + 2*x end |
|||
RC.find_roots(f, -1..3)</syntaxhighlight> |
|||
Data 1, -1E9, 1 |
|||
Data 1, 0, 1 |
|||
Data 2, -1, -6 |
|||
Data 1, 2, -2 |
|||
Data 0.5, 1.4142135623731, 1 |
|||
Data 1, 3, 2 |
|||
Data 3, 4, 5 |
|||
Data 1, -1e100, 1 |
|||
Data 1, -1e200, 1 |
|||
Data 1, -1e300, 1</syntaxhighlight> |
|||
{{out}} |
{{out}} |
||
<pre>1: is the naieve way |
|||
<pre> |
|||
2: is the cautious way |
|||
Root found at 8.81239525796218e-16 |
|||
3: is the naieve way with help of GMP |
|||
Root found at 1.0000000000000016 |
|||
Root found at 1.9999999999998914 |
|||
</pre> |
|||
Find root(s) for 1X^2-1000000000X+1 |
|||
=={{header|Erlang}}== |
|||
1: the real roots are 1000000000 and 0 |
|||
<syntaxhighlight lang="erlang">% Implemented by Arjun Sunel |
|||
2: the real roots are 1000000000 and 1e-009 |
|||
-module(roots). |
|||
3: the real roots are 9.9999999999999999900000000e+08 and 1.0000000000000000010000000e-09 |
|||
-export([main/0]). |
|||
main() -> |
|||
F = fun(X)->X*X*X - 3*X*X + 2*X end, |
|||
Step = 0.001, % Using smaller steps will provide more accurate results |
|||
Start = -1, |
|||
Stop = 3, |
|||
Sign = F(Start) > 0, |
|||
X = Start, |
|||
while(X, Step, Start, Stop, Sign,F). |
|||
Find root(s) for 1X^2+0X+1 |
|||
while(X, Step, Start, Stop, Sign,F) -> |
|||
1: the complex roots are -0 +/- 1*i |
|||
Value = F(X), |
|||
2: the complex roots are -0 +/- 1*i |
|||
if |
|||
3: the complex roots are 0.0000000000000000000000000e+00 +/- 1.0000000000000000000000000e+00*i |
|||
Value == 0 -> % We hit a root |
|||
io:format("Root found at ~p~n",[X]), |
|||
while(X+Step, Step, Start, Stop, Value > 0,F); |
|||
Find root(s) for 2X^2-1X-6 |
|||
(Value < 0) == Sign -> % We passed a root |
|||
1: the real roots are 8 and -6 |
|||
io:format("Root found near ~p~n",[X]), |
|||
2: the real roots are 2 and -1.5 |
|||
while(X+Step , Step, Start, Stop, Value > 0,F); |
|||
3: the real roots are 2.0000000000000000000000000e+00 and -1.5000000000000000000000000e+00 |
|||
X > Stop -> |
|||
io:format("") ; |
|||
true -> |
|||
while(X+Step, Step, Start, Stop, Value > 0,F) |
|||
end. |
|||
</syntaxhighlight> |
|||
{{out}} |
|||
<pre>Root found near 8.81239525796218e-16 |
|||
Root found near 1.0000000000000016 |
|||
Root found near 2.0009999999998915 |
|||
ok</pre> |
|||
Find root(s) for 1X^2+2X-2 |
|||
=={{header|ERRE}}== |
|||
1: the real roots are 0.7320508075688772 and -2.732050807568877 |
|||
<syntaxhighlight lang="erre"> |
|||
2: the real roots are -2.732050807568877 and 0.7320508075688773 |
|||
PROGRAM ROOTS_FUNCTION |
|||
3: the real roots are 7.3205080756887729352744634e-01 and -2.7320508075688772935274463e+00 |
|||
Find root(s) for 0.5X^2+1.4142135623731X+1 |
|||
!VAR E,X,STP,VALUE,S%,I%,LIMIT%,X1,X2,D |
|||
1: the real roots are -0.3535533607909526 and -0.3535534203955974 |
|||
2: the real roots are -1.414213681582389 and -1.414213443163811 |
|||
3: the real roots are -1.4142134436707580875788206e+00 and -1.4142136810754419733330398e+00 |
|||
Find root(s) for 1X^2+3X+2 |
|||
FUNCTION F(X) |
|||
1: the real roots are -1 and -2 |
|||
F=X*X*X-3*X*X+2*X |
|||
2: the real roots are -2 and -0.9999999999999999 |
|||
END FUNCTION |
|||
3: the real roots are -1.0000000000000000000000000e+00 and -2.0000000000000000000000000e+00 |
|||
Find root(s) for 3X^2+4X+5 |
|||
BEGIN |
|||
1: the complex roots are -0.6666666666666666 +/- 1.105541596785133*i |
|||
X=-1 |
|||
2: the complex roots are -0.6666666666666666 +/- 1.105541596785133*i |
|||
STP=1.0E-6 |
|||
3: the complex roots are -6.6666666666666666666666667e-01 +/- 1.1055415967851332830383109e+00*i |
|||
E=1.0E-9 |
|||
S%=(F(X)>0) |
|||
Find root(s) for 1X^2-1e+100X+1 |
|||
PRINT("VERSION 1: SIMPLY STEPPING X") |
|||
1: the real roots are 1e+100 and 0 |
|||
WHILE X<3.0 DO |
|||
2: the real roots are 1e+100 and 1e-100 |
|||
VALUE=F(X) |
|||
3: the real roots are 1.0000000000000000159028911e+100 and 9.9999999999999998409710889e-101 |
|||
IF ABS(VALUE)<E THEN |
|||
PRINT("ROOT FOUND AT X =";X) |
|||
S%=NOT S% |
|||
ELSE |
|||
IF ((VALUE>0)<>S%) THEN |
|||
PRINT("ROOT FOUND AT X =";X) |
|||
S%=NOT S% |
|||
END IF |
|||
END IF |
|||
X=X+STP |
|||
END WHILE |
|||
Find root(s) for 1X^2-1e+200X+1 |
|||
PRINT |
|||
1: the real roots are 1.#INF and -1.#INF |
|||
PRINT("VERSION 2: SECANT METHOD") |
|||
2: the real roots are 1e+200 and 1e-200 |
|||
X1=-1.0 |
|||
3: the real roots are 9.9999999999999996973312221e+199 and 0.0000000000000000000000000e+00 |
|||
X2=3.0 |
|||
E=1.0E-15 |
|||
I%=1 |
|||
LIMIT%=300 |
|||
LOOP |
|||
IF I%>LIMIT% THEN |
|||
PRINT("ERROR: FUNCTION NOT CONVERGING") |
|||
EXIT |
|||
END IF |
|||
D=(X2-X1)/(F(X2)-F(X1))*F(X2) |
|||
IF ABS(D)<E THEN |
|||
IF D=0 THEN |
|||
PRINT("EXACT ";) |
|||
ELSE |
|||
PRINT("APPROXIMATE ";) |
|||
END IF |
|||
PRINT("ROOT FOUND AT X =";X2) |
|||
EXIT |
|||
END IF |
|||
X1=X2 |
|||
X2=X2-D |
|||
I%=I%+1 |
|||
END LOOP |
|||
END PROGRAM |
|||
</syntaxhighlight> |
|||
Note: Outputs are calculated in single precision. |
|||
{{out}} |
|||
<pre> |
|||
VERSION 1: SIMPLY STEPPING X |
|||
ROOT FOUND AT X = 8.866517E-07 |
|||
ROOT FOUND AT X = 1.000001 |
|||
ROOT FOUND AT X = 2 |
|||
Find root(s) for 1X^2-1e+300X+1 |
|||
VERSION 2: SECANT METHOD |
|||
1: the real roots are 1.#INF and -1.#INF |
|||
EXACT ROOT FOUND AT X = 1 |
|||
2: the real roots are 1e+300 and 1e-300 |
|||
</pre> |
|||
3: the real roots are 1.0000000000000000525047603e+300 and 0.0000000000000000000000000e+00</pre> |
|||
=={{header| |
=={{header|GAP}}== |
||
<syntaxhighlight lang="gap">QuadraticRoots := function(a, b, c) |
|||
{{works with|Fortran|90 and later}} |
|||
local d; |
|||
<syntaxhighlight lang="fortran">PROGRAM ROOTS_OF_A_FUNCTION |
|||
d := Sqrt(b*b - 4*a*c); |
|||
return [ (-b+d)/(2*a), (-b-d)/(2*a) ]; |
|||
end; |
|||
# Hint : E(12) is a 12th primitive root of 1 |
|||
IMPLICIT NONE |
|||
QuadraticRoots(2, 2, -1); |
|||
# [ 1/2*E(12)^4-1/2*E(12)^7+1/2*E(12)^8+1/2*E(12)^11, |
|||
# 1/2*E(12)^4+1/2*E(12)^7+1/2*E(12)^8-1/2*E(12)^11 ] |
|||
# This works also with floating-point numbers |
|||
INTEGER, PARAMETER :: dp = SELECTED_REAL_KIND(15) |
|||
QuadraticRoots(2.0, 2.0, -1.0); |
|||
REAL(dp) :: f, e, x, step, value |
|||
# [ 0.366025, -1.36603 ]</syntaxhighlight> |
|||
LOGICAL :: s |
|||
f(x) = x*x*x - 3.0_dp*x*x + 2.0_dp*x |
|||
x = -1.0_dp ; step = 1.0e-6_dp ; e = 1.0e-9_dp |
|||
s = (f(x) > 0) |
|||
DO WHILE (x < 3.0) |
|||
value = f(x) |
|||
IF(ABS(value) < e) THEN |
|||
WRITE(*,"(A,F12.9)") "Root found at x =", x |
|||
s = .NOT. s |
|||
ELSE IF ((value > 0) .NEQV. s) THEN |
|||
WRITE(*,"(A,F12.9)") "Root found near x = ", x |
|||
s = .NOT. s |
|||
END IF |
|||
x = x + step |
|||
END DO |
|||
END PROGRAM ROOTS_OF_A_FUNCTION</syntaxhighlight> |
|||
The following approach uses the [[wp:Secant_method|Secant Method]] to numerically find one root. Which root is found will depend on the start values x1 and x2 and if these are far from a root this method may not converge. |
|||
<syntaxhighlight lang="fortran">INTEGER, PARAMETER :: dp = SELECTED_REAL_KIND(15) |
|||
INTEGER :: i=1, limit=100 |
|||
REAL(dp) :: d, e, f, x, x1, x2 |
|||
f(x) = x*x*x - 3.0_dp*x*x + 2.0_dp*x |
|||
x1 = -1.0_dp ; x2 = 3.0_dp ; e = 1.0e-15_dp |
|||
DO |
|||
IF (i > limit) THEN |
|||
WRITE(*,*) "Function not converging" |
|||
EXIT |
|||
END IF |
|||
d = (x2 - x1) / (f(x2) - f(x1)) * f(x2) |
|||
IF (ABS(d) < e) THEN |
|||
WRITE(*,"(A,F18.15)") "Root found at x = ", x2 |
|||
EXIT |
|||
END IF |
|||
x1 = x2 |
|||
x2 = x2 - d |
|||
i = i + 1 |
|||
END DO</syntaxhighlight> |
|||
=={{header|FreeBASIC}}== |
|||
Simple bisection method. |
|||
<syntaxhighlight lang="freebasic">#Include "crt.bi" |
|||
const iterations=20000000 |
|||
sub bisect( f1 as function(as double) as double,min as double,max as double,byref O as double,a() as double) |
|||
dim as double last,st=(max-min)/iterations,v |
|||
for n as double=min to max step st |
|||
v=f1(n) |
|||
if sgn(v)<>sgn(last) then |
|||
redim preserve a(1 to ubound(a)+1) |
|||
a(ubound(a))=n |
|||
O=n+st:exit sub |
|||
end if |
|||
last=v |
|||
next |
|||
end sub |
|||
function roots(f1 as function(as double) as double,min as double,max as double, a() as double) as long |
|||
redim a(0) |
|||
dim as double last,O,st=(max-min)/iterations,v |
|||
for n as double=min to max step st |
|||
v=f1(n) |
|||
if sgn(v)<>sgn(last) and n>min then bisect(f1,n-st,n,O,a()):n=O |
|||
last=v |
|||
next |
|||
return ubound(a) |
|||
end function |
|||
Function CRound(Byval x As Double,Byval precision As Integer=30) As String |
|||
If precision>30 Then precision=30 |
|||
Dim As zstring * 40 z:Var s="%." &str(Abs(precision)) &"f" |
|||
sprintf(z,s,x) |
|||
If Val(z) Then Return Rtrim(Rtrim(z,"0"),".")Else Return "0" |
|||
End Function |
|||
function defn(x as double) as double |
|||
return x^3-3*x^2+2*x |
|||
end function |
|||
redim as double r() |
|||
print |
|||
if roots(@defn,-20,20,r()) then |
|||
print "in range -20 to 20" |
|||
print "All roots approximate" |
|||
print "number","root to 6 dec places","function value at root" |
|||
for n as long=1 to ubound(r) |
|||
print n,CRound(r(n),6),,defn(r(n)) |
|||
next n |
|||
end if |
|||
sleep</syntaxhighlight> |
|||
{{out}} |
|||
<pre>in range -20 to 20 |
|||
All roots approximate |
|||
number root to 6 dec places function value at root |
|||
1 0 -2.929925652002424e-009 |
|||
2 1 1.477781779325033e-009 |
|||
3 2 -2.897852187377925e-009</pre> |
|||
=={{header|Go}}== |
=={{header|Go}}== |
||
Secant method. No error checking. |
|||
<syntaxhighlight lang="go">package main |
<syntaxhighlight lang="go">package main |
||
import ( |
import ( |
||
"fmt" |
|||
"math" |
|||
) |
) |
||
func qr(a, b, c float64) ([]float64, []complex128) { |
|||
func main() { |
|||
d := b*b-4*a*c |
|||
example := func(x float64) float64 { return x*x*x - 3*x*x + 2*x } |
|||
switch { |
|||
findroots(example, -.5, 2.6, 1) |
|||
case d == 0: |
|||
// single root |
|||
return []float64{-b/(2*a)}, nil |
|||
case d > 0: |
|||
// two real roots |
|||
if b < 0 { |
|||
d = math.Sqrt(d)-b |
|||
} else { |
|||
d = -math.Sqrt(d)-b |
|||
} |
|||
return []float64{d/(2*a), (2*c)/d}, nil |
|||
case d < 0: |
|||
// two complex roots |
|||
den := 1/(2*a) |
|||
t1 := complex(-b*den, 0) |
|||
t2 := complex(0, math.Sqrt(-d)*den) |
|||
return nil, []complex128{t1+t2, t1-t2} |
|||
} |
|||
// otherwise d overflowed or a coefficient was NAN |
|||
return []float64{d}, nil |
|||
} |
} |
||
func |
func test(a, b, c float64) { |
||
fmt.Print("coefficients: ", a, b, c, " -> ") |
|||
for x0, x1 := lower, lower+step; x0 < upper; x0, x1 = x1, x1+step { |
|||
r, i := qr(a, b, c) |
|||
x1 = math.Min(x1, upper) |
|||
switch len(r) { |
|||
r, status := secant(f, x0, x1) |
|||
case 1: |
|||
if status != "" && r >= x0 && r < x1 { |
|||
fmt.Println("one real root:", r[0]) |
|||
case 2: |
|||
} |
|||
fmt.Println("two real roots:", r[0], r[1]) |
|||
} |
|||
default: |
|||
fmt.Println("two complex roots:", i[0], i[1]) |
|||
} |
|||
} |
} |
||
func main() { |
|||
func secant(f func(float64) float64, x0, x1 float64) (float64, string) { |
|||
for _, c := range [][3]float64{ |
|||
{1, -2, 1}, |
|||
f1 := f(x0) |
|||
{1, 0, 1}, |
|||
{1, -10, 1}, |
|||
f0, f1 = f1, f(x1) |
|||
{1, -1000, 1}, |
|||
switch { |
|||
{1, -1e9, 1}, |
|||
case f1 == 0: |
|||
} { |
|||
return x1, "exact" |
|||
test(c[0], c[1], c[2]) |
|||
case math.Abs(x1-x0) < 1e-6: |
|||
} |
|||
return x1, "approximate" |
|||
} |
|||
x0, x1 = x1, x1-f1*(x1-x0)/(f1-f0) |
|||
} |
|||
return 0, "" |
|||
}</syntaxhighlight> |
}</syntaxhighlight> |
||
{{out}} |
|||
Output: |
|||
<pre> |
<pre> |
||
coefficients: 1 -2 1 -> one real root: 1 |
|||
0.000 approximate |
|||
coefficients: 1 0 1 -> two complex roots: (0+1i) (-0-1i) |
|||
1.000 exact |
|||
coefficients: 1 -10 1 -> two real roots: 9.898979485566356 0.10102051443364381 |
|||
2.000 approximate |
|||
coefficients: 1 -1000 1 -> two real roots: 999.998999999 0.001000001000002 |
|||
coefficients: 1 -1e+09 1 -> two real roots: 1e+09 1e-09 |
|||
</pre> |
</pre> |
||
=={{header|Haskell}}== |
=={{header|Haskell}}== |
||
<syntaxhighlight lang="haskell"> |
<syntaxhighlight lang="haskell">import Data.Complex (Complex, realPart) |
||
type CD = Complex Double |
|||
findRoots start stop step eps = |
|||
[x | x <- [start, start+step .. stop], abs (f x) < eps]</syntaxhighlight> |
|||
Executed in GHCi: |
|||
<syntaxhighlight lang="haskell">*Main> findRoots (-1.0) 3.0 0.0001 0.000000001 |
|||
[-9.381755897326649e-14,0.9999999999998124,1.9999999999997022]</syntaxhighlight> |
|||
quadraticRoots :: (CD, CD, CD) -> (CD, CD) |
|||
Or using package [http://hackage.haskell.org/package/hmatrix hmatrix] from HackageDB. |
|||
quadraticRoots (a, b, c) |
|||
<syntaxhighlight lang="haskell">import Numeric.GSL.Polynomials |
|||
| 0 < realPart b = |
|||
import Data.Complex |
|||
( (2 * c) / (- b - d), |
|||
(- b - d) / (2 * a) |
|||
) |
|||
| otherwise = |
|||
( (- b + d) / (2 * a), |
|||
(2 * c) / (- b + d) |
|||
) |
|||
where |
|||
d = sqrt $ b ^ 2 - 4 * a * c |
|||
main :: IO () |
|||
*Main> mapM_ print $ polySolve [0,2,-3,1] |
|||
main = |
|||
(-5.421010862427522e-20) :+ 0.0 |
|||
mapM_ |
|||
2.000000000000001 :+ 0.0 |
|||
(print . quadraticRoots) |
|||
0.9999999999999996 :+ 0.0</syntaxhighlight> |
|||
[ (3, 4, 4 / 3), |
|||
No complex roots, so: |
|||
(3, 2, -1), |
|||
<syntaxhighlight lang="haskell">*Main> mapM_ (print.realPart) $ polySolve [0,2,-3,1] |
|||
(3, 2, 1), |
|||
-5.421010862427522e-20 |
|||
(1, -10e5, 1), |
|||
2.000000000000001 |
|||
(1, -10e9, 1) |
|||
0.9999999999999996</syntaxhighlight> |
|||
]</syntaxhighlight> |
|||
{{Out}} |
|||
<pre>((-0.6666666666666666) :+ 0.0,(-0.6666666666666666) :+ 0.0) |
|||
(0.3333333333333333 :+ 0.0,(-1.0) :+ 0.0) |
|||
((-0.33333333333333326) :+ 0.4714045207910316,(-0.3333333333333333) :+ (-0.47140452079103173)) |
|||
(999999.999999 :+ 0.0,1.000000000001e-6 :+ 0.0) |
|||
(1.0e10 :+ 0.0,1.0e-10 :+ 0.0)</pre> |
|||
=={{header|Icon}} and {{header|Unicon}}== |
|||
It is possible to solve the problem directly and elegantly using robust bisection method and Alternative type class. |
|||
<syntaxhighlight lang="haskell">import Control.Applicative |
|||
{{trans|Ada}} |
|||
data Root a = Exact a | Approximate a deriving (Show, Eq) |
|||
Works in both languages. |
|||
-- looks for roots on an interval |
|||
<syntaxhighlight lang="unicon">procedure main() |
|||
bisection :: (Alternative f, Floating a, Ord a) => |
|||
solve(1.0, -10.0e5, 1.0) |
|||
(a -> a) -> a -> a -> f (Root a) |
|||
end |
|||
bisection f a b | f a * f b > 0 = empty |
|||
| f a == 0 = pure (Exact a) |
|||
| f b == 0 = pure (Exact b) |
|||
| smallInterval = pure (Approximate c) |
|||
| otherwise = bisection f a c <|> bisection f c b |
|||
where c = (a + b) / 2 |
|||
smallInterval = abs (a-b) < 1e-15 || abs ((a-b)/c) < 1e-15 |
|||
procedure solve(a,b,c) |
|||
-- looks for roots on a grid |
|||
d := sqrt(b*b - 4.0*a*c) |
|||
findRoots :: (Alternative f, Floating a, Ord a) => |
|||
( |
roots := if b < 0 then [r1 := (-b+d)/(2.0*a), c/(a*r1)] |
||
else [r1 := (-b-d)/(2.0*a), c/(a*r1)] |
|||
findRoots f [] = empty |
|||
write(a,"*x^2 + ",b,"*x + ",c," has roots ",roots[1]," and ",roots[2]) |
|||
findRoots f [x] = if f x == 0 then pure (Exact x) else empty |
|||
end</syntaxhighlight> |
|||
{{out}} |
|||
It is possible to use these functions with different Alternative functors: IO, Maybe or List: |
|||
<pre> |
|||
<pre>λ> bisection (\x -> x*x-2) 1 2 |
|||
->rqf 1.0 -0.000000001 1.0 |
|||
Approximate 1.414213562373094 |
|||
1.0*x^2 + -1000000.0*x + 1.0 has roots 999999.999999 and 1.000000000001e-06 |
|||
λ> bisection (\x -> x-1) 1 2 |
|||
-> |
|||
Exact 1.0 |
|||
</pre> |
|||
λ> bisection (\x -> x*x-2) 2 3 :: Maybe (Root Double) |
|||
Nothing |
|||
λ> findRoots (\x -> x^3 - 3*x^2 + 2*x) [-3..3] :: Maybe (Root Double) |
|||
Just (Exact 0.0) |
|||
λ> findRoots (\x -> x^3 - 3*x^2 + 2*x) [-3..3] :: [Root Double] |
|||
[Exact 0.0,Exact 0.0,Exact 1.0,Exact 2.0]</pre> |
|||
=={{header|IDL}}== |
|||
To get rid of repeated roots use `Data.List.nub` |
|||
<syntaxhighlight lang="idl">compile_OPT IDL2 |
|||
<pre>λ> Data.List.nub $ findRoots (\x -> x^3 - 3*x^2 + 2*x) [-3..3] |
|||
[Exact 0.0,Exact 1.0,Exact 2.0] |
|||
λ> Data.List.nub $ findRoots (\x -> x^3 - 3*x^2 + x) [-3..3] |
|||
[Exact 0.0,Approximate 2.6180339887498967]</pre> |
|||
print, "input a, press enter, input b, press enter, input c, press enter" |
|||
=={{header|HicEst}}== |
|||
read,a,b,c |
|||
HicEst's [http://www.HicEst.com/SOLVE.htm SOLVE] function employs the Levenberg-Marquardt method: |
|||
Promt='Enter values of a,b,c and hit enter' |
|||
<syntaxhighlight lang="hicest">OPEN(FIle='test.txt') |
|||
a0=0.0 |
|||
1 DLG(NameEdit=x0, DNum=3) |
|||
b0=0.0 |
|||
c0=0.0 ;make them floating point variables |
|||
x=-b+sqrt((b^2)-4*a*c) |
|||
x = x0 |
|||
y=-b-sqrt((b^2)-4*a*c) |
|||
chi2 = SOLVE(NUL=x^3 - 3*x^2 + 2*x, Unknown=x, I=iterations, NumDiff=1E-15) |
|||
z=2*a |
|||
EDIT(Text='approximate exact ', Word=(chi2 == 0), Parse=solution) |
|||
d= x/z |
|||
e= y/z |
|||
print, d,e</syntaxhighlight> |
|||
WRITE(FIle='test.txt', LENgth=6, Name) x0, x, solution, chi2, iterations |
|||
GOTO 1</syntaxhighlight> |
|||
<syntaxhighlight lang="hicest">x0=0.5; x=1; solution=exact; chi2=79E-32 iterations=65; |
|||
x0=0.4; x=2E-162 solution=exact; chi2=0; iterations=1E4; |
|||
x0=0.45; x=1; solution=exact; chi2=79E-32 iterations=67; |
|||
x0=0.42; x=2E-162 solution=exact; chi2=0; iterations=1E4; |
|||
x0=1.5; x=1.5; solution=approximate; chi2=0.1406; iterations=14: |
|||
x0=1.54; x=1; solution=exact; chi2=44E-32 iterations=63; |
|||
x0=1.55; x=2; solution=exact; chi2=79E-32 iterations=55; |
|||
x0=1E10; x=2; solution=exact; chi2=18E-31 iterations=511; |
|||
x0=-1E10; x=0; solution=exact; chi2=0; iterations=1E4;</syntaxhighlight> |
|||
=={{header| |
=={{header|IS-BASIC}}== |
||
<syntaxhighlight lang="is-basic"> |
|||
{{trans|Java}} |
|||
100 PROGRAM "Quadratic.bas" |
|||
110 PRINT "Enter coefficients a, b and c:":INPUT PROMPT "a= ,b= ,c= ":A,B,C |
|||
120 IF A=0 THEN |
|||
130 PRINT "The coefficient of x^2 can not be 0." |
|||
140 ELSE |
|||
150 LET D=B^2-4*A*C |
|||
160 SELECT CASE SGN(D) |
|||
170 CASE 0 |
|||
180 PRINT "The single root is ";-B/2/A |
|||
190 CASE 1 |
|||
200 PRINT "The real roots are ";(-B+SQR(D))/(2*A);"and ";(-B-SQR(D))/(2*A) |
|||
210 CASE -1 |
|||
220 PRINT "The complex roots are ";-B/2/A;"+/- ";STR$(SQR(-D)/2/A);"*i" |
|||
230 END SELECT |
|||
240 END IF</syntaxhighlight> |
|||
=={{header|J}}== |
|||
Works in both languages: |
|||
'''Solution''' use J's built-in polynomial solver: |
|||
<syntaxhighlight lang="unicon">procedure main() |
|||
p. |
|||
showRoots(f, -1.0, 4, 0.002) |
|||
end |
|||
This primitive converts between the coefficient form of a polynomial (with the exponents being the array indices of the coefficients) and the multiplier-and-roots for of a polynomial (with two boxes, the first containing the multiplier and the second containing the roots). |
|||
procedure f(x) |
|||
return x^3 - 3*x^2 + 2*x |
|||
end |
|||
'''Example''' using inputs from other solutions and the unstable example from the task description: |
|||
procedure showRoots(f, lb, ub, step) |
|||
ox := x := lb |
|||
oy := f(x) |
|||
os := sign(oy) |
|||
while x <= ub do { |
|||
if (s := sign(y := f(x))) = 0 then write(x) |
|||
else if s ~= os then { |
|||
dx := x-ox |
|||
dy := y-oy |
|||
cx := x-dx*(y/dy) |
|||
write("~",cx) |
|||
} |
|||
(ox := x, oy := y, os := s) |
|||
x +:= step |
|||
} |
|||
end |
|||
<syntaxhighlight lang="j"> coeff =. _3 |.\ 3 4 4r3 3 2 _1 3 2 1 1 _1e6 1 1 _1e9 1 |
|||
procedure sign(x) |
|||
> {:"1 p. coeff |
|||
return (x<0, -1) | (x>0, 1) | 0 |
|||
_0.666667 _0.666667 |
|||
end</syntaxhighlight> |
|||
_1 0.333333 |
|||
_0.333333j0.471405 _0.333333j_0.471405 |
|||
1e6 1e_6 |
|||
1e9 1e_9</syntaxhighlight> |
|||
Of course <code>p.</code> generalizes to polynomials of arbitrary order (which isn't as great as that might sound, because of practical limitations). Given the coefficients <code>p.</code> returns the multiplier and roots of the polynomial. Given the multiplier and roots it returns the coefficients. For example using the cubic <math>0 + 16x - 12x^2 + 2x^3</math>: |
|||
Output: |
|||
<syntaxhighlight lang="j"> p. 0 16 _12 2 NB. return multiplier ; roots |
|||
<pre> |
|||
+-+-----+ |
|||
->roots |
|||
|2|4 2 0| |
|||
~2.616794878713638e-18 |
|||
+-+-----+ |
|||
~1.0 |
|||
p. 2 ; 4 2 0 NB. return coefficients |
|||
~2.0 |
|||
0 16 _12 2</syntaxhighlight> |
|||
-> |
|||
</pre> |
|||
Exploring the limits of precision: |
|||
=={{header|J}}== |
|||
<syntaxhighlight lang="j"> 1{::p. 1 _1e5 1 NB. display roots |
|||
J has builtin a root-finding operator, '''<tt>p.</tt>''', whose input is the coeffiecients of the polynomial (where the exponent of the indeterminate variable matches the index of the coefficient: 0 1 2 would be 0 + x + (2 times x squared)). Hence: |
|||
100000 1e_5 |
|||
1 _1e5 1 p. 1{::p. 1 _1e5 1 NB. test roots |
|||
_3.38436e_7 0 |
|||
1 _1e5 1 p. 1e5 1e_5 NB. test displayed roots |
|||
1 9.99999e_11 |
|||
1e5 1e_5 - 1{::p. 1 _1e5 1 NB. find difference |
|||
1e_5 _1e_15 |
|||
1 _1e5 1 p. 1e5 1e_5-1e_5 _1e_15 NB. test displayed roots with adjustment |
|||
_3.38436e_7 0</syntaxhighlight> |
|||
When these "roots" are plugged back into the original polynomial, the results are nowhere near zero. However, double precision floating point does not have enough bits to represent the (extremely close) answers that would give a zero result. |
|||
<syntaxhighlight lang="j"> 1{::p. 0 2 _3 1 |
|||
2 1 0</syntaxhighlight> |
|||
Middlebrook formula implemented in J |
|||
We can determine whether the roots are exact or approximate by evaluating the polynomial at the candidate roots, and testing for zero: |
|||
<syntaxhighlight lang="j"> |
<syntaxhighlight lang="j">q_r=: verb define |
||
'a b c' =. y |
|||
1 1 1</syntaxhighlight> |
|||
q=. b %~ %: a * c |
|||
f=. 0.5 + 0.5 * %:(1-4*q*q) |
|||
(-b*f%a),(-c%b*f) |
|||
) |
|||
q_r 1 _1e6 1 |
|||
As you can see, <tt>p.</tt> is also the operator which evaluates polynomials. This is not a coincidence. |
|||
1e6 1e_6</syntaxhighlight> |
|||
=={{header|Java}}== |
|||
That said, we could also implement the technique used by most others here. Specifically: we can implement the function as a black box and check every 1 millionth of a unit between minus one and three, and we can test that result for exactness. |
|||
<syntaxhighlight lang="java">public class QuadraticRoots { |
|||
private static class Complex { |
|||
double re, im; |
|||
public Complex(double re, double im) { |
|||
<syntaxhighlight lang="j"> blackbox=: 0 2 _3 1&p. |
|||
this.re = re; |
|||
(#~ (=<./)@:|@blackbox) i.&.(1e6&*)&.(1&+) 3 |
|||
this.im = im; |
|||
0 1 2 |
|||
} |
|||
1 1 1</syntaxhighlight> |
|||
@Override |
|||
Here, we see that each of the results (0, 1 and 2) are as accurate as we expect our computer arithmetic to be. (The = returns 1 where paired values are equal and 0 where they are not equal). |
|||
public boolean equals(Object obj) { |
|||
if (obj == this) {return true;} |
|||
if (!(obj instanceof Complex)) {return false;} |
|||
Complex other = (Complex) obj; |
|||
return (re == other.re) && (im == other.im); |
|||
} |
|||
@Override |
|||
=={{header|Java}}== |
|||
public String toString() { |
|||
<syntaxhighlight lang="java">public class Roots { |
|||
if (im == 0.0) {return String.format("%g", re);} |
|||
public interface Function { |
|||
if (re == 0.0) {return String.format("%gi", im);} |
|||
public double f(double x); |
|||
return String.format("%g %c %gi", re, |
|||
(im < 0.0 ? '-' : '+'), Math.abs(im)); |
|||
} |
|||
} |
} |
||
private static |
private static Complex[] quadraticRoots(double a, double b, double c) { |
||
Complex[] roots = new Complex[2]; |
|||
double d = b * b - 4.0 * a * c; // discriminant |
|||
} |
|||
double aa = a + a; |
|||
if (d < 0.0) { |
|||
public static void printRoots(Function f, double lowerBound, |
|||
double re = -b / aa; |
|||
double im = Math.sqrt(-d) / aa; |
|||
double x = lowerBound, ox = x; |
|||
roots[0] = new Complex(re, im); |
|||
double y = f.f(x), oy = y; |
|||
roots[1] = new Complex(re, -im); |
|||
int s = sign(y), os = s; |
|||
} else if (b < 0.0) { |
|||
// Avoid calculating -b - Math.sqrt(d), to avoid any |
|||
for (; x <= upperBound ; x += step) { |
|||
// subtractive cancellation when it is near zero. |
|||
s = sign(y = f.f(x)); |
|||
double re = (-b + Math.sqrt(d)) / aa; |
|||
if (s == 0) { |
|||
roots[0] = new Complex(re, 0.0); |
|||
System.out.println(x); |
|||
roots[1] = new Complex(c / (a * re), 0.0); |
|||
} else if (s != os) { |
|||
} else { |
|||
double dx = x - ox; |
|||
// Avoid calculating -b + Math.sqrt(d). |
|||
double dy = y - oy; |
|||
double re = (-b - Math.sqrt(d)) / aa; |
|||
roots[1] = new Complex(re, 0.0); |
|||
System.out.println("~" + cx); |
|||
roots[0] = new Complex(c / (a * re), 0.0); |
|||
} |
|||
} |
|||
return roots; |
|||
} |
|||
} |
} |
||
public static void main(String[] args) { |
public static void main(String[] args) { |
||
double[][] equations = { |
|||
Function poly = new Function () { |
|||
{1.0, 22.0, -1323.0}, // two distinct real roots |
|||
public double f(double x) { |
|||
{6.0, -23.0, 20.0}, // with a != 1.0 |
|||
return x*x*x - 3*x*x + 2*x; |
|||
{1.0, -1.0e9, 1.0}, // with one root near zero |
|||
} |
|||
{1.0, 2.0, 1.0}, // one real root (double root) |
|||
}; |
|||
{1.0, 0.0, 1.0}, // two imaginary roots |
|||
printRoots(poly, -1.0, 4, 0.002); |
|||
{1.0, 1.0, 1.0} // two complex roots |
|||
}; |
|||
for (int i = 0; i < equations.length; i++) { |
|||
Complex[] roots = quadraticRoots( |
|||
equations[i][0], equations[i][1], equations[i][2]); |
|||
System.out.format("%na = %g b = %g c = %g%n", |
|||
equations[i][0], equations[i][1], equations[i][2]); |
|||
if (roots[0].equals(roots[1])) { |
|||
System.out.format("X1,2 = %s%n", roots[0]); |
|||
} else { |
|||
System.out.format("X1 = %s%n", roots[0]); |
|||
System.out.format("X2 = %s%n", roots[1]); |
|||
} |
|||
} |
|||
} |
} |
||
}</syntaxhighlight> |
}</syntaxhighlight> |
||
{{out}} |
|||
Produces this output: |
|||
<pre> |
|||
<pre>~2.616794878713638E-18 |
|||
a = 1.00000 b = 22.0000 c = -1323.00 |
|||
~1.0000000000000002 |
|||
X1 = 27.0000 |
|||
~2.000000000000001</pre> |
|||
X2 = -49.0000 |
|||
a = 6.00000 b = -23.0000 c = 20.0000 |
|||
=={{header|JavaScript}}== |
|||
X1 = 2.50000 |
|||
{{trans|Java}} |
|||
X2 = 1.33333 |
|||
{{works with|SpiderMonkey|22}} |
|||
{{works with|Firefox|22}} |
|||
<syntaxhighlight lang="javascript"> |
|||
// This function notation is sorta new, but useful here |
|||
// Part of the EcmaScript 6 Draft |
|||
// developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Functions_and_function_scope |
|||
var poly = (x => x*x*x - 3*x*x + 2*x); |
|||
a = 1.00000 b = -1.00000e+09 c = 1.00000 |
|||
function sign(x) { |
|||
X1 = 1.00000e+09 |
|||
return (x < 0.0) ? -1 : (x > 0.0) ? 1 : 0; |
|||
X2 = 1.00000e-09 |
|||
} |
|||
a = 1.00000 b = 2.00000 c = 1.00000 |
|||
function printRoots(f, lowerBound, upperBound, step) { |
|||
X1,2 = -1.00000 |
|||
var x = lowerBound, ox = x, |
|||
y = f(x), oy = y, |
|||
s = sign(y), os = s; |
|||
a = 1.00000 b = 0.00000 c = 1.00000 |
|||
for (; x <= upperBound ; x += step) { |
|||
X1 = 1.00000i |
|||
s = sign(y = f(x)); |
|||
X2 = -1.00000i |
|||
if (s == 0) { |
|||
console.log(x); |
|||
} |
|||
else if (s != os) { |
|||
var dx = x - ox; |
|||
var dy = y - oy; |
|||
var cx = x - dx * (y / dy); |
|||
console.log("~" + cx); |
|||
} |
|||
ox = x; oy = y; os = s; |
|||
} |
|||
} |
|||
a = 1.00000 b = 1.00000 c = 1.00000 |
|||
printRoots(poly, -1.0, 4, 0.002); |
|||
X1 = -0.500000 + 0.866025i |
|||
</syntaxhighlight> |
|||
X2 = -0.500000 - 0.866025i</pre> |
|||
=={{header|jq}}== |
=={{header|jq}}== |
||
{{ works with |jq|1.4}} |
|||
printRoots(f; lower; upper; step) finds approximations to the roots |
|||
Currently jq does not include support for complex number operations, so |
|||
of an arbitrary continuous real-valued function, f, in the range |
|||
a small library is included in the first section. |
|||
[lower, upper], assuming step is small enough. |
|||
The second section defines <tt>quadratic_roots(a;b;c)</tt>, |
|||
The algorithm is similar to that used for example in the Javascript section on this page, except that a bug has been removed at the point when the previous and current signs are compared. |
|||
which emits a stream of 0 or two solutions, or the value <tt>true</tt> if a==b==c==0. |
|||
The third section defines a function for producing a table showing (i, error, solution) for solutions to x^2 - 10^i + 1 = 0 for various values of i. |
|||
The function, f, may be an expression (as in the example below) or a defined filter. |
|||
'''Section 1''': Complex numbers (scrolling window) |
|||
printRoots/3 emits an array of results, each of which is either a |
|||
<div style="overflow:scroll; height:200px;"> |
|||
number (representing an exact root within the limits of machine arithmetic) or a string consisting of "~" followed by an approximation to the root. |
|||
<syntaxhighlight lang="jq"> |
<syntaxhighlight lang="jq"># Complex numbers as points [x,y] in the Cartesian plane |
||
if |
def real(z): if (z|type) == "number" then z else z[0] end; |
||
def imag(z): if (z|type) == "number" then 0 else z[1] end; |
|||
def printRoots(f; lowerBound; upperBound; step): |
|||
lowerBound as $x |
|||
| ($x|f) as $y |
|||
| ($y|sign) as $s |
|||
| reduce range($x; upperBound+step; step) as $x |
|||
# state: [ox, oy, os, roots] |
|||
( [$x, $y, $s, [] ]; |
|||
.[0] as $ox | .[1] as $oy | .[2] as $os |
|||
| ($x|f) as $y |
|||
| ($y | sign) as $s |
|||
| if $s == 0 then [$x, $y, $s, (.[3] + [$x] )] |
|||
elif $s != $os and $os != 0 then |
|||
($x - $ox) as $dx |
|||
| ($y - $oy) as $dy |
|||
| ($x - ($dx * $y / $dy)) as $cx # by geometry |
|||
| [$x, $y, $s, (.[3] + [ "~\($cx)" ])] # an approximation |
|||
else [$x, $y, $s, .[3] ] |
|||
end ) |
|||
| .[3] ; |
|||
</syntaxhighlight> |
|||
We present two examples, one where step is a power of 1/2, and one where it is not: |
|||
{{Out}} |
|||
<syntaxhighlight lang="jq">printRoots( .*.*. - 3*.*. + 2*.; -1.0; 4; 1/256) |
|||
def plus(x; y): |
|||
[ |
|||
if (x|type) == "number" then |
|||
0, |
|||
if (y|type) == "number" then [ x+y, 0 ] |
|||
1, |
|||
else [ x + y[0], y[1]] |
|||
2 |
|||
end |
|||
] |
|||
elif (y|type) == "number" then plus(y;x) |
|||
else [ x[0] + y[0], x[1] + y[1] ] |
|||
end; |
|||
def multiply(x; y): |
|||
if (x|type) == "number" then |
|||
if (y|type) == "number" then [ x*y, 0 ] |
|||
else [x * y[0], x * y[1]] |
|||
end |
|||
elif (y|type) == "number" then multiply(y;x) |
|||
else [ x[0] * y[0] - x[1] * y[1], x[0] * y[1] + x[1] * y[0]] |
|||
end; |
|||
def negate(x): multiply(-1; x); |
|||
printRoots( .*.*. - 3*.*. + 2*.; -1.0; 4; .001) |
|||
[ |
|||
"~1.320318770141425e-18", |
|||
"~1.0000000000000002", |
|||
"~1.9999999999999993" |
|||
]</syntaxhighlight> |
|||
def minus(x; y): plus(x; multiply(-1; y)); |
|||
=={{header|Julia}}== |
|||
def conjugate(z): |
|||
if (z|type) == "number" then [z, 0] |
|||
else [z[0], -(z[1]) ] |
|||
end; |
|||
def invert(z): |
|||
Assuming that one has the Roots package installed: |
|||
if (z|type) == "number" then [1/z, 0] |
|||
else |
|||
( (z[0] * z[0]) + (z[1] * z[1]) ) as $d |
|||
# use "0 + ." to convert -0 back to 0 |
|||
| [ z[0]/$d, (0 + -(z[1]) / $d)] |
|||
end; |
|||
def divide(x;y): multiply(x; invert(y)); |
|||
<syntaxhighlight lang="julia">using Roots |
|||
def magnitude(z): |
|||
println(find_zero(x -> x^3 - 3x^2 + 2x, (-100, 100)))</syntaxhighlight> |
|||
real( multiply(z; conjugate(z))) | sqrt; |
|||
# exp^z |
|||
{{out}} |
|||
def complex_exp(z): |
|||
def expi(x): [ (x|cos), (x|sin) ]; |
|||
if (z|type) == "number" then z|exp |
|||
elif z[0] == 0 then expi(z[1]) # for efficiency |
|||
else multiply( (z[0]|exp); expi(z[1]) ) |
|||
end ; |
|||
def complex_sqrt(z): |
|||
<pre>[0.0,1.0,2.0]</pre> |
|||
if imag(z) == 0 and real(z) >= 0 then [(real(z)|sqrt), 0] |
|||
else |
|||
magnitude(z) as $r |
|||
| if $r == 0 then [0,0] |
|||
else |
|||
(real(z)/$r) as $a |
|||
| (imag(z)/$r) as $b |
|||
| $r | sqrt as $r |
|||
| (($a | acos) / 2) |
|||
| [ ($r * cos), ($r * sin)] |
|||
end |
|||
end ;</syntaxhighlight></div> |
|||
'''Section 2:''' quadratic_roots(a;b;c) |
|||
<syntaxhighlight lang="jq"># If there are infinitely many solutions, emit true; |
|||
# if none, emit empty; |
|||
# otherwise always emit two. |
|||
# For numerical accuracy, Middlebrook's approach is adopted: |
|||
def quadratic_roots(a; b; c): |
|||
if a == 0 and b == 0 then |
|||
if c == 0 then true # infinitely many |
|||
else empty # none |
|||
end |
|||
elif a == 0 then [-c/b, 0] |
|||
elif b == 0 then (complex_sqrt(1/a) | (., negate(.))) |
|||
else |
|||
divide( plus(1.0; complex_sqrt( minus(1.0; (4 * a * c / (b*b))))); 2) as $f |
|||
| negate(divide(multiply(b; $f); a)), |
|||
negate(divide(c; multiply(b; $f))) |
|||
end |
|||
;</syntaxhighlight> |
|||
'''Section 3''': |
|||
Produce a table showing [i, error, solution] for solutions to x^2 - 10^i + 1 = 0 |
|||
<syntaxhighlight lang="jq">def example: |
|||
def pow(i): . as $in | reduce range(0;i) as $i (1; . * $in); |
|||
def poly(a;b;c): plus( plus( multiply(a; multiply(.;.)); multiply(b;.)); c); |
|||
def abs: if . < 0 then -. else . end; |
|||
def zero(z): |
|||
if z == 0 then 0 |
|||
else (magnitude(z)|abs) as $zero |
|||
| if $zero < 1e-10 then "+0" else $zero end |
|||
end; |
|||
def lpad(n): tostring | (n - length) * " " + .; |
|||
range(0; 13) as $i |
|||
| (- (10|pow($i))) as $b |
|||
| quadratic_roots(1; $b; 1) as $x |
|||
| $x | poly(1; $b; 1) as $zero |
|||
| "\($i|lpad(4)): error = \(zero($zero)|lpad(18)) x=\($x)" |
|||
; |
|||
example</syntaxhighlight> |
|||
Without the Roots package, Newton's method may be defined in this manner: |
|||
{{Out}} (scrolling window) |
|||
<syntaxhighlight lang="julia">function newton(f, fp, x::Float64,tol=1e-14::Float64,maxsteps=100::Int64) |
|||
<div style="overflow:scroll; height:200px;"> |
|||
##f: the function of x |
|||
<syntaxhighlight lang="sh"> |
|||
##fp: the derivative of f |
|||
$ jq -M -r -n -f Roots_of_a_quadratic_function.jq |
|||
0: error = +0 x=[0.5,0.8660254037844386] |
|||
local xnew, xold = x, Inf |
|||
0: error = +0 x=[0.5000000000000001,-0.8660254037844387] |
|||
local fn, fo = f(xnew), Inf |
|||
1: error = +0 x=[9.898979485566356,0] |
|||
local counter = 1 |
|||
1: error = +0 x=[0.10102051443364382,-0] |
|||
2: error = +0 x=[99.98999899979995,0] |
|||
while (counter < maxsteps) && (abs(xnew - xold) > tol) && ( abs(fn - fo) > tol ) |
|||
2: error = +0 x=[0.010001000200050014,-0] |
|||
x = xnew - f(xnew)/fp(xnew) ## update x |
|||
3: error = 1.1641532182693481e-10 x=[999.998999999,0] |
|||
xnew, xold = x, xnew |
|||
3: error = +0 x=[0.0010000010000019998,-0] |
|||
fn, fo = f(xnew), fn |
|||
4: error = +0 x=[9999.999899999999,0] |
|||
counter += 1 |
|||
4: error = +0 x=[0.00010000000100000003,-0] |
|||
end |
|||
5: error = +0 x=[99999.99999,0] |
|||
5: error = +0 x=[1.0000000001e-05,-0] |
|||
if counter >= maxsteps |
|||
6: error = 0.0001220703125 x=[999999.9999989999,0] |
|||
error("Did not converge in ", string(maxsteps), " steps") |
|||
6: error = +0 x=[1.000000000001e-06,-0] |
|||
else |
|||
7: error = 0.015625 x=[9999999.9999999,0] |
|||
xnew, counter |
|||
7: error = +0 x=[1.0000000000000101e-07,-0] |
|||
end |
|||
8: error = 1 x=[99999999.99999999,0] |
|||
8: error = +0 x=[1e-08,-0] |
|||
9: error = 1 x=[1000000000,0] |
|||
9: error = +0 x=[1e-09,-0] |
|||
10: error = 1 x=[10000000000,0] |
|||
10: error = +0 x=[1e-10,-0] |
|||
11: error = 1 x=[100000000000,0] |
|||
11: error = +0 x=[1e-11,-0] |
|||
12: error = 1 x=[1000000000000,0] |
|||
12: error = +0 x=[1e-12,-0]</syntaxhighlight></div> |
|||
=={{header|Julia}}== |
|||
This solution is an implementation of algorithm from the Goldberg paper cited in the task description. It does check for <tt>a=0</tt> and returns the linear solution in that case. Julia's <tt>sqrt</tt> throws a domain error for negative real inputs, so negative discriminants are converted to complex by adding <tt>0im</tt> prior to taking the square root. |
|||
Alternative solutions might make use of Julia's Polynomials or Roots packages. |
|||
<syntaxhighlight lang="julia">using Printf |
|||
function quadroots(x::Real, y::Real, z::Real) |
|||
a, b, c = promote(float(x), y, z) |
|||
if a ≈ 0.0 return [-c / b] end |
|||
Δ = b ^ 2 - 4a * c |
|||
if Δ ≈ 0.0 return [-sqrt(c / a)] end |
|||
if Δ < 0.0 Δ = complex(Δ) end |
|||
d = sqrt(Δ) |
|||
if b < 0.0 |
|||
d -= b |
|||
return [d / 2a, 2c / d] |
|||
else |
|||
d = -d - b |
|||
return [2c / d, d / 2a] |
|||
end |
|||
end |
end |
||
</syntaxhighlight> |
|||
a = [1, 1, 1.0, 10] |
|||
Finding the roots of f(x) = x3 - 3x2 + 2x: |
|||
b = [10, 2, -10.0 ^ 9, 1] |
|||
c = [1, 1, 1, 1] |
|||
for (x, y, z) in zip(a, b, c) |
|||
<syntaxhighlight lang="julia"> |
|||
@printf "The roots of %.2fx² + %.2fx + %.2f\n\tx₀ = (%s)\n" x y z join(round.(quadroots(x, y, z), 2), ", ") |
|||
f(x) = x^3 - 3*x^2 + 2*x |
|||
end</syntaxhighlight> |
|||
fp(x) = 3*x^2-6*x+2 |
|||
x_s, count = newton(f,fp,1.00) |
|||
</syntaxhighlight> |
|||
{{out}} |
{{out}} |
||
<pre>The roots of 1.00x² + 10.00x + 1.00 |
|||
x₀ = (-0.1, -9.9) |
|||
The roots of 1.00x² + 2.00x + 1.00 |
|||
x₀ = (-1.0) |
|||
The roots of 1.00x² + -1000000000.00x + 1.00 |
|||
x₀ = (1.0e9, 0.0) |
|||
The roots of 10.00x² + 1.00x + 1.00 |
|||
x₀ = (-0.05 + 0.31im, -0.05 - 0.31im)</pre> |
|||
=={{header|K}}== |
|||
(1.0,2) |
|||
===K6=== |
|||
{{works with|ngn/k}} |
|||
<syntaxhighlight lang="k"> / naive method |
|||
/ sqr[x] and sqrt[x] must be provided |
|||
quf:{[a;b;c]; s:sqrt[sqr[b]-4*a*c];(-b+s;-b-s)%2*a} |
|||
quf[0.5;-2.5;2] |
|||
1.0 4.0 |
|||
quf[1;8;15] |
|||
-5.0 -3.0 |
|||
quf[1;10;1] |
|||
-9.898979485566356 -0.10102051443364424 |
|||
</syntaxhighlight> |
|||
=={{header|Kotlin}}== |
=={{header|Kotlin}}== |
||
{{trans| |
{{trans|Java}} |
||
<syntaxhighlight lang="scala"> |
<syntaxhighlight lang="scala">import java.lang.Math.* |
||
data class Equation(val a: Double, val b: Double, val c: Double) { |
|||
data class Complex(val r: Double, val i: Double) { |
|||
override fun toString() = when { |
|||
i == 0.0 -> r.toString() |
|||
r == 0.0 -> "${i}i" |
|||
else -> "$r + ${i}i" |
|||
} |
|||
} |
|||
data class Solution(val x1: Any, val x2: Any) { |
|||
fun f(x: Double) = x * x * x - 3.0 * x * x + 2.0 * x |
|||
override fun toString() = when(x1) { |
|||
x2 -> "X1,2 = $x1" |
|||
else -> "X1 = $x1, X2 = $x2" |
|||
} |
|||
} |
|||
val quadraticRoots by lazy { |
|||
fun secant(x1: Double, x2: Double, f: DoubleToDouble): Double { |
|||
val |
val _2a = a + a |
||
val d = b * b - 4.0 * a * c // discriminant |
|||
val limit = 50 |
|||
if (d < 0.0) { |
|||
val r = -b / _2a |
|||
val i = sqrt(-d) / _2a |
|||
Solution(Complex(r, i), Complex(r, -i)) |
|||
var i = 0 |
|||
} else { |
|||
// avoid calculating -b +/- sqrt(d), to avoid any |
|||
var fb = f(xb) |
|||
// subtractive cancellation when it is near zero. |
|||
if ( |
val r = if (b < 0.0) (-b + sqrt(d)) / _2a else (-b - sqrt(d)) / _2a |
||
Solution(r, c / (a * r)) |
|||
} |
|||
xb -= d |
|||
} |
} |
||
if (i == limit) { |
|||
println("Function is not converging near (${"%7.4f".format(xa)}, ${"%7.4f".format(xb)}).") |
|||
return -99.0 |
|||
} |
|||
return xb |
|||
} |
} |
||
fun main(args: Array<String>) { |
fun main(args: Array<String>) { |
||
val equations = listOf(Equation(1.0, 22.0, -1323.0), // two distinct real roots |
|||
val step = 1.0e-2 |
|||
Equation(6.0, -23.0, 20.0), // with a != 1.0 |
|||
val e = 1.0e-12 |
|||
Equation(1.0, -1.0e9, 1.0), // with one root near zero |
|||
var x = -1.032 |
|||
Equation(1.0, 2.0, 1.0), // one real root (double root) |
|||
var s = f(x) > 0.0 |
|||
Equation(1.0, 0.0, 1.0), // two imaginary roots |
|||
while (x < 3.0) { |
|||
Equation(1.0, 1.0, 1.0)) // two complex roots |
|||
val value = f(x) |
|||
if (Math.abs(value) < e) { |
|||
equations.forEach { println("$it\n" + it.quadraticRoots) } |
|||
s = f(x + 0.0001) > 0.0 |
|||
} |
|||
else if ((value > 0.0) != s) { |
|||
val xx = secant(x - step, x, ::f) |
|||
if (xx != -99.0) |
|||
println("Root found at x = ${"%12.9f".format(xx)}") |
|||
else |
|||
println("Root found near x = ${"%7.4f".format(x)}") |
|||
s = f(x + 0.0001) > 0.0 |
|||
} |
|||
x += step |
|||
} |
|||
}</syntaxhighlight> |
}</syntaxhighlight> |
||
{{out}} |
{{out}} |
||
<pre>Equation(a=1.0, b=22.0, c=-1323.0) |
|||
<pre> |
|||
X1 = -49.0, X2 = 27.0 |
|||
Root found at x = 0.000000000 |
|||
Equation(a=6.0, b=-23.0, c=20.0) |
|||
Root found at x = 1.000000000 |
|||
X1 = 2.5, X2 = 1.3333333333333333 |
|||
Root found at x = 2.000000000 |
|||
Equation(a=1.0, b=-1.0E9, c=1.0) |
|||
</pre> |
|||
X1 = 1.0E9, X2 = 1.0E-9 |
|||
Equation(a=1.0, b=2.0, c=1.0) |
|||
X1,2 = -1.0 |
|||
Equation(a=1.0, b=0.0, c=1.0) |
|||
X1 = 1.0i, X2 = -1.0i |
|||
Equation(a=1.0, b=1.0, c=1.0) |
|||
X1 = -0.5 + 0.8660254037844386i, X2 = -0.5 + -0.8660254037844386i</pre> |
|||
=={{header| |
=={{header|lambdatalk}}== |
||
<syntaxhighlight lang="scheme"> |
<syntaxhighlight lang="scheme"> |
||
1) using lambdas: |
|||
1) defining the function: |
|||
{def func {lambda {:x} {+ {* 1 :x :x :x} {* -3 :x :x} {* 2 :x}}}} |
|||
-> func |
|||
{def equation |
|||
2) printing roots: |
|||
{lambda {:a :b :c} |
|||
{b equation :a*x{sup 2}+:b*x+:c=0} |
|||
{if {< {abs {func :x}} 0.0001} |
|||
{{lambda {:a' :b' :d} |
|||
then {br}- a root found at :x else}} |
|||
{if {> :d 0} |
|||
then {{lambda {:b' :d'} |
|||
-> |
|||
{equation.disp {+ :b' :d'} {- :b' :d'} 2 real roots} |
|||
- a root found at 7.528699885739343e-16 |
|||
} :b' {/ {sqrt :d} :a'}} |
|||
- a root found at 1.0000000000000013 |
|||
else {if {< :d 0} |
|||
- a root found at 2.000000000000002 |
|||
then {{lambda {:b' :d'} |
|||
{equation.disp [:b',:d'] [:b',-:d'] 2 complex roots} |
|||
} :b' {/ {sqrt {- :d}} :a'} } |
|||
else {equation.disp :b' :b' one real double root} |
|||
}} |
|||
} {* 2 :a} {/ {- :b} {* 2 :a}} {- {* :b :b} {* 4 :a :c}} } }} |
|||
2) using let: |
|||
3) printing the roots of the "sin" function between -720° to +720°; |
|||
{def equation |
|||
{S.map {lambda {:x} |
|||
{lambda {:a :b :c} |
|||
{if {< {abs {sin {* {/ {PI} 180} :x}}} 0.01} |
|||
{b equation :a*x{sup 2}+:b*x+:c=0} |
|||
then {br}- a root found at :x° else}} |
|||
{let { {:a' {* 2 :a}} |
|||
{:b' {/ {- :b} {* 2 :a}}} |
|||
-> |
|||
{:d {- {* :b :b} {* 4 :a :c}}} } |
|||
{if {> :d 0} |
|||
- a root found at -540° |
|||
then {let { {:b' :b'} |
|||
- a root found at -360° |
|||
{:d' {/ {sqrt :d} :a'}} } |
|||
{equation.disp {+ :b' :d'} {- :b' :d'} 2 real roots} } |
|||
else {if {< :d 0} |
|||
- a root found at 180° |
|||
then {let { {:b' :b'} |
|||
- a root found at 360° |
|||
{:d' {/ {sqrt {- :d}} :a'}} } |
|||
{equation.disp [:b',:d'] [:b',-:d'] 2 complex roots} } |
|||
- a root found at 720° |
|||
else {equation.disp :b' :b' one real double root} }} }}} |
|||
</syntaxhighlight> |
|||
3) a function to display results in an HTML table format |
|||
=={{header|Liberty BASIC}}== |
|||
<syntaxhighlight lang="lb">' Finds and output the roots of a given function f(x), |
|||
' within a range of x values. |
|||
{def equation.disp |
|||
' [RC]Roots of an function |
|||
{lambda {:x1 :x2 :txt} |
|||
{table {@ style="background:#ffa"} |
|||
{tr {td :txt: }} |
|||
{tr {td x1 = :x1 }} |
|||
{tr {td x2 = :x2 }} } }} |
|||
4) testing: |
|||
mainwin 80 12 |
|||
equation 1*x2+1*x+-1=0 |
|||
xMin =-1 |
|||
2 real roots: |
|||
xMax = 3 |
|||
x1 = 0.6180339887498949 |
|||
y =f( xMin) ' Since Liberty BASIC has an 'eval(' function the fn |
|||
x2 = -1.618033988749895 |
|||
' and limits would be better entered via 'input'. |
|||
equation 1*x2+1*x+1=0 |
|||
2 complex roots: |
|||
x1 = [-0.5,0.8660254037844386] |
|||
x2 = [-0.5,-0.8660254037844386] |
|||
equation 1*x2+-2*x+1=0 |
|||
eps =1E-12 ' closeness acceptable |
|||
one real double root: |
|||
x1 = 1 |
|||
bigH=0.01 |
|||
x2 = 1 |
|||
</syntaxhighlight> |
|||
print |
|||
print " Checking for roots of x^3 -3 *x^2 +2 *x =0 over range -1 to +3" |
|||
print |
|||
x=xMin: dx = bigH |
|||
do |
|||
x=x+dx |
|||
y = f(x) |
|||
'print x, dx, y |
|||
if y*LastY <0 then 'there is a root, should drill deeper |
|||
if dx < eps then 'we are close enough |
|||
print " Just crossed axis, solution f( x) ="; y; " at x ="; using( "#.#####", x) |
|||
LastY = y |
|||
dx = bigH 'after closing on root, continue with big step |
|||
else |
|||
x=x-dx 'step back |
|||
dx = dx/10 'repeat with smaller step |
|||
end if |
|||
end if |
|||
loop while x<xMax |
|||
print |
|||
print " Finished checking in range specified." |
|||
=={{header|Liberty BASIC}}== |
|||
<syntaxhighlight lang="lb">a=1:b=2:c=3 |
|||
'assume a<>0 |
|||
print quad$(a,b,c) |
|||
end |
end |
||
function quad$(a,b,c) |
|||
D=b^2-4*a*c |
|||
x=-1*b |
|||
end function</syntaxhighlight> |
|||
if D<0 then |
|||
quad$=str$(x/(2*a));" +i";str$(sqr(abs(D))/(2*a));" , ";str$(x/(2*a));" -i";str$(sqr(abs(D))/abs(2*a)) |
|||
else |
|||
quad$=str$(x/(2*a)+sqr(D)/(2*a));" , ";str$(x/(2*a)-sqr(D)/(2*a)) |
|||
end if |
|||
end function</syntaxhighlight> |
|||
=={{header|Logo}}== |
|||
<syntaxhighlight lang="logo">to quadratic :a :b :c |
|||
localmake "d sqrt (:b*:b - 4*:a*:c) |
|||
if :b < 0 [make "d minus :d] |
|||
output list (:d-:b)/(2*:a) (2*:c)/(:d-:b) |
|||
end</syntaxhighlight> |
|||
=={{header|Lua}}== |
=={{header|Lua}}== |
||
In order to correctly handle complex roots, qsolve must be given objects from a suitable complex number library, |
|||
<syntaxhighlight lang="lua">-- Function to have roots found |
|||
like that from the Complex Numbers article. However, this should be enough to demonstrate its accuracy: |
|||
function f (x) return x^3 - 3*x^2 + 2*x end |
|||
<syntaxhighlight lang="lua">function qsolve(a, b, c) |
|||
-- Find roots of f within x=[start, stop] or approximations thereof |
|||
if b < 0 then return qsolve(-a, -b, -c) end |
|||
function root (f, start, stop, step) |
|||
val = b + (b^2 - 4*a*c)^(1/2) --this never exhibits instability if b > 0 |
|||
local roots, x, sign, foundExact, value = {}, start, f(start) > 0 |
|||
return -val / (2 * a), -2 * c / val --2c / val is the same as the "unstable" second root |
|||
while x <= stop do |
|||
value = f(x) |
|||
if value == 0 then |
|||
table.insert(roots, {val = x, err = 0}) |
|||
foundExact = true |
|||
end |
|||
if value > 0 ~= sign then |
|||
if foundExact then |
|||
foundExact = false |
|||
else |
|||
table.insert(roots, {val = x, err = step}) |
|||
end |
|||
end |
|||
sign = value > 0 |
|||
x = x + step |
|||
end |
|||
return roots |
|||
end |
end |
||
for i = 1, 12 do |
|||
-- Main procedure |
|||
print( |
print(qsolve(1, 0-10^i, 1)) |
||
for _, r in pairs(root(f, -1, 3, 10^-6)) do |
|||
print(string.format("%0.12f", r.val), r.err) |
|||
end</syntaxhighlight> |
end</syntaxhighlight> |
||
The "trick" lies in avoiding subtracting large values that differ by a small amount, which is the source of instability in the "normal" formula. It is trivial to prove that 2c/(b + sqrt(b^2-4ac)) = (b - sqrt(b^2-4ac))/2a. |
|||
{{out}} |
|||
<pre>Root (to 12DP) Max. Error |
|||
0.000000000008 1e-06 |
|||
1.000000000016 1e-06 |
|||
2.000000999934 1e-06</pre> |
|||
Note that the roots found are all near misses because fractional numbers that seem nice and 'round' in decimal (such as 10^-6) often have some rounding error when represented in binary. To increase the chances of finding exact integer roots, try using an integer start value with a step value that is a power of two. |
|||
<syntaxhighlight lang="lua">-- Main procedure |
|||
print("Root (to 12DP)\tMax. Error\n") |
|||
for _, r in pairs(root(f, -1, 3, 2^-10)) do |
|||
print(string.format("%0.12f", r.val), r.err) |
|||
end</syntaxhighlight> |
|||
{{out}} |
|||
<pre>Root (to 12DP) Max. Error |
|||
0.000000000000 0 |
|||
1.000000000000 0 |
|||
2.000000000000 0</pre> |
|||
=={{header|Maple}}== |
=={{header|Maple}}== |
||
<syntaxhighlight lang="maple">solve(a*x^2+b*x+c,x); |
|||
solve(1.0*x^2-10.0^9*x+1.0,x,explicit,allsolutions); |
|||
<syntaxhighlight lang="maple">f := x^3-3*x^2+2*x; |
|||
roots(f,x);</syntaxhighlight> |
|||
fsolve(x^2-10^9*x+1,x,complex);</syntaxhighlight> |
|||
outputs: |
|||
{{out}} |
|||
<pre> (1/2) (1/2) |
|||
/ 2\ / 2\ |
|||
-b + \-4 a c + b / b + \-4 a c + b / |
|||
-----------------------, - ---------------------- |
|||
2 a 2 a |
|||
9 -9 |
|||
1.000000000 10 , 1.000000000 10 |
|||
-9 9 |
|||
<syntaxhighlight lang="maple">[[0, 1], [1, 1], [2, 1]]</syntaxhighlight> |
|||
1.000000000 10 , 1.000000000 10 </pre> |
|||
=={{header|Mathematica}}/{{header|Wolfram Language}}== |
|||
which means there are three roots. Each root is named as a pair where the first element is the value (0, 1, and 2), the second one the multiplicity (=1 for each means none of the three are degenerate). |
|||
Possible ways to do this are (symbolic and numeric examples): |
|||
<syntaxhighlight lang="mathematica">Solve[a x^2 + b x + c == 0, x] |
|||
Solve[x^2 - 10^5 x + 1 == 0, x] |
|||
Root[#1^2 - 10^5 #1 + 1 &, 1] |
|||
Root[#1^2 - 10^5 #1 + 1 &, 2] |
|||
Reduce[a x^2 + b x + c == 0, x] |
|||
Reduce[x^2 - 10^5 x + 1 == 0, x] |
|||
FindInstance[x^2 - 10^5 x + 1 == 0, x, Reals, 2] |
|||
FindRoot[x^2 - 10^5 x + 1 == 0, {x, 0}] |
|||
FindRoot[x^2 - 10^5 x + 1 == 0, {x, 10^6}]</syntaxhighlight> |
|||
gives back: |
|||
<math>\left\{\left\{x\to \frac{-b-\sqrt{b^2-4 a c}}{2 a}\right\},\left\{x\to \frac{-b+\sqrt{b^2-4 a c}}{2 a}\right\}\right\}</math> |
|||
By itself (i.e. unless specifically asked to do so), Maple will only perform exact (symbolic) operations and not attempt to do any kind of numerical approximation. |
|||
<math>\left\{\left\{x\to \frac{1}{50000+\sqrt{2499999999}}\right\},\left\{x\to 50000+\sqrt{2499999999}\right\}\right\}</math> |
|||
=={{header|Mathematica}}/{{header|Wolfram Language}}== |
|||
There are multiple obvious ways to do this in Mathematica. |
|||
===Solve=== |
|||
This requires a full equation and will perform symbolic operations only: |
|||
<syntaxhighlight lang="mathematica">Solve[x^3-3*x^2+2*x==0,x]</syntaxhighlight> |
|||
Output |
|||
<pre> {{x->0},{x->1},{x->2}}</pre> |
|||
<math>50000-\sqrt{2499999999}</math> |
|||
===NSolve=== |
|||
This requires merely the polynomial and will perform numerical operations if needed: |
|||
<syntaxhighlight lang="mathematica"> NSolve[x^3 - 3*x^2 + 2*x , x]</syntaxhighlight> |
|||
Output |
|||
<pre> {{x->0.},{x->1.},{x->2.}}</pre> |
|||
(note that the results here are floats) |
|||
<math>50000+\sqrt{2499999999}</math> |
|||
===FindRoot=== |
|||
This will numerically try to find one(!) local root from a given starting point: |
|||
<syntaxhighlight lang="mathematica">FindRoot[x^3 - 3*x^2 + 2*x , {x, 1.5}]</syntaxhighlight> |
|||
Output |
|||
<pre> {x->0.}</pre> |
|||
From a different start point: |
|||
<syntaxhighlight lang="mathematica">FindRoot[x^3 - 3*x^2 + 2*x , {x, 1.1}]</syntaxhighlight> |
|||
Output |
|||
<pre>{x->1.}</pre> |
|||
(note that there is no guarantee which one is found). |
|||
<math>\begin{align} |
|||
===FindInstance=== |
|||
\Biggl( |
|||
This finds a value (optionally out of a given domain) for the given variable (or a set of values for a set of given variables) that satisfy a given equality or inequality: |
|||
a & \neq 0 \And \And |
|||
<syntaxhighlight lang="mathematica"> FindInstance[x^3 - 3*x^2 + 2*x == 0, x]</syntaxhighlight> |
|||
\left( |
|||
Output |
|||
x==\frac{-b-\sqrt{b^2-4 a c}}{2 a} |
|||
<pre>{{x->0}}</pre> |
|||
\| |
|||
x==\frac{-b+\sqrt{b^2-4 a c}}{2 a} |
|||
\right) |
|||
\Biggr)\\ |
|||
&\biggl\| |
|||
\left( |
|||
a==0 \And\And b\neq 0 \And\And x==-\frac{c}{b} |
|||
\right)\\ |
|||
&\biggr\| |
|||
(c==0 \And \And b==0 \And \And a==0) |
|||
\end{align} |
|||
</math> |
|||
<math>x==\frac{1}{50000+\sqrt{2499999999}}\|x==50000+\sqrt{2499999999}</math> |
|||
===Reduce=== |
|||
This will (symbolically) reduce a given expression to the simplest possible form, solving equations and performing substitutions in the process: |
|||
<syntaxhighlight lang="mathematica">Reduce[x^3 - 3*x^2 + 2*x == 0, x]</syntaxhighlight> |
|||
<pre> x==0||x==1||x==2</pre> |
|||
(note that this doesn't yield a "solution" but a different expression that expresses the same thing as the original) |
|||
<math>\left\{\left\{x\to \frac{1}{50000+\sqrt{2499999999}}\right\},\left\{x\to 50000+\sqrt{2499999999}\right\}\right\}</math> |
|||
=={{header|Maxima}}== |
|||
<syntaxhighlight lang="maxima">e: x^3 - 3*x^2 + 2*x$ |
|||
<math>\{x\to 0.00001\}</math> |
|||
/* Number of roots in a real interval, using Sturm sequences */ |
|||
nroots(e, -10, 10); |
|||
3 |
|||
<math>\{x\to 100000.\}</math> |
|||
solve(e, x); |
|||
[x=1, x=2, x=0] |
|||
Note that some functions do not really give the answer (like reduce) rather it gives another way of writing it (boolean expression). However note that reduce gives the explicit cases for a zero and nonzero, b zero and nonzero, et cetera. Some functions are numeric by nature, other can handle both symbolic and numeric. In generals the solution will be exact if the input is exact. Any exact result can be approximated to '''arbitrary''' precision using the function N[expression,number of digits]. Further notice that some functions give back exact answers in a different form then others, however the answers are both correct, the answers are just written differently. |
|||
/* 'solve sets the system variable 'multiplicities */ |
|||
=={{header|MATLAB}} / {{header|Octave}}== |
|||
solve(x^4 - 2*x^3 + 2*x - 1, x); |
|||
<syntaxhighlight lang="matlab">roots([1 -3 2]) % coefficients in decreasing order of power e.g. [x^n ... x^2 x^1 x^0]</syntaxhighlight> |
|||
[x=-1, x=1] |
|||
=={{header|Maxima}}== |
|||
multiplicities; |
|||
<syntaxhighlight lang="maxima">solve(a*x^2 + b*x + c = 0, x); |
|||
[1, 3] |
|||
/* 2 2 |
|||
/* Rational approximation of roots using Sturm sequences and bisection */ |
|||
sqrt(b - 4 a c) + b sqrt(b - 4 a c) - b |
|||
[x = - --------------------, x = --------------------] |
|||
2 a 2 a */ |
|||
fpprec: 40$ |
|||
realroots(e); |
|||
[x=1, x=2, x=0] |
|||
solve(x^2 - 10^9*x + 1 = 0, x); |
|||
/* 'realroots also sets the system variable 'multiplicities */ |
|||
/* [x = 500000000 - sqrt(249999999999999999), |
|||
x = sqrt(249999999999999999) + 500000000] */ |
|||
bfloat(%); |
|||
multiplicities; |
|||
/* [x = 1.0000000000000000009999920675269450501b-9, |
|||
[1, 1, 1] |
|||
x = 9.99999999999999998999999999999999999b8] */</syntaxhighlight> |
|||
=={{header|МК-61/52}}== |
|||
/* Numerical root using Brent's method (here with another equation) */ |
|||
<syntaxhighlight lang="text">П2 С/П /-/ <-> / 2 / П3 x^2 С/П |
|||
ИП2 / - Вx <-> КвКор НОП x>=0 28 ИП3 |
|||
x<0 24 <-> /-/ + / Вx С/П /-/ КвКор |
|||
ИП3 С/П</syntaxhighlight> |
|||
''Input:'' a С/П b С/П c С/П |
|||
find_root(sin(t) - 1/2, t, 0, %pi/2); |
|||
0.5235987755983 |
|||
{{out}} x<sub>1</sub> - РX; x<sub>2</sub> - РY (or error message, if D < 0). |
|||
fpprec: 60$ |
|||
=={{header|Modula-3}}== |
|||
bf_find_root(sin(t) - 1/2, t, 0, %pi/2); |
|||
{{trans|Ada}} |
|||
5.23598775598298873077107230546583814032861566562517636829158b-1 |
|||
<syntaxhighlight lang="modula3">MODULE Quad EXPORTS Main; |
|||
IMPORT IO, Fmt, Math; |
|||
/* Numerical root using Newton's method */ |
|||
TYPE Roots = ARRAY [1..2] OF LONGREAL; |
|||
load(newton1)$ |
|||
newton(e, x, 1.1, 1e-6); |
|||
1.000000017531147 |
|||
VAR r: Roots; |
|||
/* For polynomials, Jenkins–Traub algorithm */ |
|||
PROCEDURE Solve(a, b, c: LONGREAL): Roots = |
|||
allroots(x^3 + x + 1); |
|||
VAR sd: LONGREAL := Math.sqrt(b * b - 4.0D0 * a * c); |
|||
[x=1.161541399997252*%i+0.34116390191401, |
|||
x: LONGREAL; |
|||
x=0.34116390191401-1.161541399997252*%i, |
|||
BEGIN |
|||
x=-0.68232780382802] |
|||
IF b < 0.0D0 THEN |
|||
x := (-b + sd) / (2.0D0 * a); |
|||
RETURN Roots{x, c / (a * x)}; |
|||
ELSE |
|||
x := (-b - sd) / (2.0D0 * a); |
|||
RETURN Roots{c / (a * x), x}; |
|||
END; |
|||
END Solve; |
|||
BEGIN |
|||
bfallroots(x^3 + x + 1); |
|||
r := Solve(1.0D0, -10.0D5, 1.0D0); |
|||
[x=1.16154139999725193608791768724717407484314725802151429063617b0*%i + 3.41163901914009663684741869855524128445594290948999288901864b-1, |
|||
IO.Put("X1 = " & Fmt.LongReal(r[1]) & " X2 = " & Fmt.LongReal(r[2]) & "\n"); |
|||
x=3.41163901914009663684741869855524128445594290948999288901864b-1 - 1.16154139999725193608791768724717407484314725802151429063617b0*%i, |
|||
END Quad.</syntaxhighlight> |
|||
=={{header|Nim}}== |
=={{header|Nim}}== |
||
<syntaxhighlight lang="nim">import math |
<syntaxhighlight lang="nim">import math, complex, strformat |
||
import strformat |
|||
const Epsilon = 1e-15 |
|||
func f(x: float): float = x ^ 3 - 3 * x ^ 2 + 2 * x |
|||
type |
|||
var |
|||
step = 0.01 |
|||
start = -1.0 |
|||
stop = 3.0 |
|||
sign = f(start) > 0 |
|||
x = start |
|||
SolKind = enum solDouble, solFloat, solComplex |
|||
while x <= stop: |
|||
var value = f(x) |
|||
if value == 0: |
|||
echo fmt"Root found at {x:.5f}" |
|||
elif (value > 0) != sign: |
|||
echo fmt"Root found near {x:.5f}" |
|||
sign = value > 0 |
|||
x += step</syntaxhighlight> |
|||
Roots = object |
|||
{{out}} |
|||
case kind: SolKind |
|||
<pre> |
|||
of solDouble: |
|||
Root found near 0.00000 |
|||
fvalue: float |
|||
Root found near 1.00000 |
|||
of solFloat: |
|||
Root found near 2.00000 |
|||
fvalues: (float, float) |
|||
</pre> |
|||
of solComplex: |
|||
cvalues: (Complex64, Complex64) |
|||
=={{header|Objeck}}== |
|||
{{trans|C++}} |
|||
<syntaxhighlight lang="objeck"> |
|||
bundle Default { |
|||
class Roots { |
|||
function : f(x : Float) ~ Float |
|||
{ |
|||
return (x*x*x - 3.0*x*x + 2.0*x); |
|||
} |
|||
function : Main(args : String[]) ~ Nil |
|||
{ |
|||
step := 0.001; |
|||
start := -1.0; |
|||
stop := 3.0; |
|||
value := f(start); |
|||
sign := (value > 0); |
|||
if(0.0 = value) { |
|||
start->PrintLine(); |
|||
}; |
|||
for(x := start + step; x <= stop; x += step;) { |
|||
value := f(x); |
|||
if((value > 0) <> sign) { |
|||
IO.Console->Instance()->Print("~")->PrintLine(x); |
|||
} |
|||
else if(0 = value) { |
|||
IO.Console->Instance()->Print("~")->PrintLine(x); |
|||
}; |
|||
sign := (value > 0); |
|||
}; |
|||
} |
|||
} |
|||
} |
|||
</syntaxhighlight> |
|||
func quadRoots(a, b, c: float): Roots = |
|||
=={{header|OCaml}}== |
|||
if a == 0: |
|||
raise newException(ValueError, "first coefficient cannot be null.") |
|||
let den = a * 2 |
|||
let Δ = b * b - a * c * 4 |
|||
if abs(Δ) < Epsilon: |
|||
result = Roots(kind: solDouble, fvalue: -b / den) |
|||
elif Δ < 0: |
|||
let r = -b / den |
|||
let i = sqrt(-Δ) / den |
|||
result = Roots(kind: solComplex, cvalues: (complex64(r, i), complex64(r, -i))) |
|||
else: |
|||
let r = (if b < 0: -b + sqrt(Δ) else: -b - sqrt(Δ)) / den |
|||
result = Roots(kind: solFloat, fvalues: (r, c / (a * r))) |
|||
A general root finder using the False Position (Regula Falsi) method, which will find all simple roots given a small step size. |
|||
func `$`(r: Roots): string = |
|||
<syntaxhighlight lang="ocaml">let bracket u v = |
|||
case r.kind |
|||
((u > 0.0) && (v < 0.0)) || ((u < 0.0) && (v > 0.0));; |
|||
of solDouble: |
|||
result = $r.fvalue |
|||
of solFloat: |
|||
result = &"{r.fvalues[0]}, {r.fvalues[1]}" |
|||
of solComplex: |
|||
result = &"{r.cvalues[0].re} + {r.cvalues[0].im}i, {r.cvalues[1].re} + {r.cvalues[1].im}i" |
|||
let xtol a b = (a = b);; (* or use |a-b| < epsilon *) |
|||
when isMainModule: |
|||
let rec regula_falsi a b fa fb f = |
|||
if xtol a b then (a, fa) else |
|||
let c = (fb*.a -. fa*.b) /. (fb -. fa) in |
|||
let fc = f c in |
|||
if fc = 0.0 then (c, fc) else |
|||
if bracket fa fc then |
|||
regula_falsi a c fa fc f |
|||
else |
|||
regula_falsi c b fc fb f;; |
|||
const Equations = [(1.0, -2.0, 1.0), |
|||
let search lo hi step f = |
|||
(10.0, 1.0, 1.0), |
|||
let rec next x fx = |
|||
(1.0, -10.0, 1.0), |
|||
if x > hi then [] else |
|||
(1.0, -1000.0, 1.0), |
|||
(1.0, -1e9, 1.0)] |
|||
if fx = 0.0 then |
|||
(x,fx) :: next y fy |
|||
else if bracket fx fy then |
|||
(regula_falsi x y fx fy f) :: next y fy |
|||
else |
|||
next y fy in |
|||
next lo (f lo);; |
|||
for (a, b, c) in Equations: |
|||
let showroot (x,fx) = |
|||
echo &"Equation: {a=}, {b=}, {c=}" |
|||
Printf.printf "f(%.17f) = %.17f [%s]\n" |
|||
let roots = quadRoots(a, b, c) |
|||
x fx (if fx = 0.0 then "exact" else "approx") in |
|||
let plural = if roots.kind == solDouble: "" else: "s" |
|||
let f x = ((x -. 3.0)*.x +. 2.0)*.x in |
|||
echo &" root{plural}: {roots}"</syntaxhighlight> |
|||
{{out}} |
|||
Output: |
|||
<pre>Equation: a=1.0, b=-2.0, c=1.0 |
|||
<pre> |
|||
root: 1.0 |
|||
f(0.00000000000000000) = 0.00000000000000000 [exact] |
|||
Equation: a=10.0, b=1.0, c=1.0 |
|||
f(1.00000000000000022) = 0.00000000000000000 [exact] |
|||
roots: -0.05 + 0.3122498999199199i, -0.05 + -0.3122498999199199i |
|||
f(1.99999999999999978) = 0.00000000000000000 [exact] |
|||
Equation: a=1.0, b=-10.0, c=1.0 |
|||
</pre> |
|||
roots: 9.898979485566356, 0.1010205144336438 |
|||
Equation: a=1.0, b=-1000.0, c=1.0 |
|||
roots: 999.998999999, 0.001000001000002 |
|||
Equation: a=1.0, b=-1000000000.0, c=1.0 |
|||
roots: 1000000000.0, 1e-09</pre> |
|||
=={{header|OCaml}}== |
|||
Note these roots are exact solutions with floating-point calculation. |
|||
<syntaxhighlight lang="ocaml">type quadroots = |
|||
=={{header|Octave}}== |
|||
| RealRoots of float * float |
|||
| ComplexRoots of Complex.t * Complex.t ;; |
|||
let quadsolve a b c = |
|||
If the equation is a polynomial, we can put the coefficients in a vector and use ''roots'': |
|||
let d = (b *. b) -. (4.0 *. a *. c) in |
|||
if d < 0.0 |
|||
<syntaxhighlight lang="octave">a = [ 1, -3, 2, 0 ]; |
|||
then |
|||
r = roots(a); |
|||
let r = -. b /. (2.0 *. a) |
|||
% let's print it |
|||
and i = sqrt(-. d) /. (2.0 *. a) in |
|||
for i = 1:3 |
|||
ComplexRoots ({ Complex.re = r; Complex.im = i }, |
|||
n = polyval(a, r(i)); |
|||
{ Complex.re = r; Complex.im = (-.i) }) |
|||
printf("x%d = %f (%f", i, r(i), n); |
|||
else |
|||
if (n != 0.0) |
|||
let r = |
|||
if b < 0.0 |
|||
endif |
|||
then ((sqrt d) -. b) /. (2.0 *. a) |
|||
printf(" exact)\n"); |
|||
else ((sqrt d) +. b) /. (-2.0 *. a) |
|||
endfor</syntaxhighlight> |
|||
in |
|||
RealRoots (r, c /. (r *. a)) |
|||
Otherwise we can program our (simple) method: |
|||
;;</syntaxhighlight> |
|||
{{trans|Python}} |
|||
<syntaxhighlight lang="octave">function y = f(x) |
|||
y = x.^3 -3.*x.^2 + 2.*x; |
|||
endfunction |
|||
step = 0.001; |
|||
tol = 10 .* eps; |
|||
start = -1; |
|||
stop = 3; |
|||
se = sign(f(start)); |
|||
x = start; |
|||
while (x <= stop) |
|||
v = f(x); |
|||
if ( (v < tol) && (v > -tol) ) |
|||
printf("root at %f\n", x); |
|||
elseif ( sign(v) != se ) |
|||
printf("root near %f\n", x); |
|||
endif |
|||
se = sign(v); |
|||
x = x + step; |
|||
endwhile</syntaxhighlight> |
|||
=={{header|Oforth}}== |
|||
<syntaxhighlight lang="oforth">: findRoots(f, a, b, st) |
|||
| x y lasty | |
|||
a f perform dup ->y ->lasty |
|||
a b st step: x [ |
|||
x f perform -> y |
|||
y ==0 ifTrue: [ System.Out "Root found at " << x << cr ] |
|||
else: [ y lasty * sgn -1 == ifTrue: [ System.Out "Root near " << x << cr ] ] |
|||
y ->lasty |
|||
] ; |
|||
: f(x) x 3 pow x sq 3 * - x 2 * + ; </syntaxhighlight> |
|||
{{out}} |
{{out}} |
||
<syntaxhighlight lang="ocaml"># quadsolve 1.0 0.0 (-2.0) ;; |
|||
<pre> |
|||
- : quadroots = RealRoots (-1.4142135623730951, 1.4142135623730949) |
|||
findRoots(#f, -1, 3, 0.0001) |
|||
Root found at 0 |
|||
Root found at 1 |
|||
Root found at 2 |
|||
# quadsolve 1.0 0.0 2.0 ;; |
|||
findRoots(#f, -1.000001, 3, 0.0001) |
|||
- : quadroots = |
|||
Root near 9.90000000000713e-005 |
|||
ComplexRoots ({Complex.re = 0.; Complex.im = 1.4142135623730951}, |
|||
Root near 1.000099 |
|||
{Complex.re = 0.; Complex.im = -1.4142135623730951}) |
|||
Root near 2.000099 |
|||
</pre> |
|||
# quadsolve 1.0 (-1.0e5) 1.0 ;; |
|||
=={{header|ooRexx}}== |
|||
- : quadroots = RealRoots (99999.99999, 1.0000000001000001e-005)</syntaxhighlight> |
|||
<syntaxhighlight lang="oorexx">/* REXX program to solve a cubic polynom equation |
|||
a*x**3+b*x**2+c*x+d =(x-x1)*(x-x2)*(x-x3) |
|||
*/ |
|||
Numeric Digits 16 |
|||
pi3=Rxcalcpi()/3 |
|||
Parse Value '1 -3 2 0' with a b c d |
|||
p=3*a*c-b**2 |
|||
q=2*b**3-9*a*b*c+27*a**2*d |
|||
det=q**2+4*p**3 |
|||
say 'p='p |
|||
say 'q='q |
|||
Say 'det='det |
|||
If det<0 Then Do |
|||
phi=Rxcalcarccos(-q/(2*rxCalcsqrt(-p**3)),16,'R') |
|||
Say 'phi='phi |
|||
phi3=phi/3 |
|||
y1=rxCalcsqrt(-p)*2*Rxcalccos(phi3,16,'R') |
|||
y2=rxCalcsqrt(-p)*2*Rxcalccos(phi3+2*pi3,16,'R') |
|||
y3=rxCalcsqrt(-p)*2*Rxcalccos(phi3+4*pi3,16,'R') |
|||
End |
|||
Else Do |
|||
t=q**2+4*p**3 |
|||
tu=-4*q+4*rxCalcsqrt(t) |
|||
tv=-4*q-4*rxCalcsqrt(t) |
|||
u=qroot(tu)/2 |
|||
v=qroot(tv)/2 |
|||
y1=u+v |
|||
y2=-(u+v)/2 (u+v)/2*rxCalcsqrt(3) |
|||
y3=-(u+v)/2 (-(u+v)/2*rxCalcsqrt(3)) |
|||
End |
|||
say 'y1='y1 |
|||
say 'y2='y2 |
|||
say 'y3='y3 |
|||
x1=y2x(y1) |
|||
x2=y2x(y2) |
|||
x3=y2x(y3) |
|||
Say 'x1='x1 |
|||
Say 'x2='x2 |
|||
Say 'x3='x3 |
|||
Exit |
|||
=={{header|Octave}}== |
|||
qroot: Procedure |
|||
See [[Quadratic Equation#MATLAB|MATLAB]]. |
|||
Parse Arg a |
|||
return sign(a)*rxcalcpower(abs(a),1/3,16) |
|||
y2x: Procedure Expose a b |
|||
Parse Arg real imag |
|||
xr=(real-b)/(3*a) |
|||
If imag<>'' Then Do |
|||
xi=(imag-b)/(3*a) |
|||
Return xr xi'i' |
|||
End |
|||
Else |
|||
Return xr |
|||
::requires 'rxmath' LIBRARY</syntaxhighlight> |
|||
{{out}} |
|||
<pre>p=-3 |
|||
q=0 |
|||
det=-108 |
|||
phi=1.570796326794897 |
|||
y1=2.999999999999999 |
|||
y2=-3.000000000000000 |
|||
y3=0.000000000000002440395154978758 |
|||
x1=2 |
|||
x2=0 |
|||
x3=1.000000000000001</pre> |
|||
=={{header|PARI/GP}}== |
=={{header|PARI/GP}}== |
||
{{works with|PARI/GP|2.8.0+}} |
|||
===Gourdon–Schönhage algorithm===<!-- X. Gourdon, "Algorithmique du théorème fondamental de l'algèbre" (1993). --> |
|||
<syntaxhighlight lang="parigp"> |
<syntaxhighlight lang="parigp">roots(a,b,c)=polrootsreal(Pol([a,b,c]))</syntaxhighlight> |
||
{{trans|C}} |
|||
===Newton's method=== |
|||
Otherwise, coding directly: |
|||
This uses a modified version of the Newton–Raphson method. |
|||
<syntaxhighlight lang="parigp"> |
<syntaxhighlight lang="parigp">roots(a,b,c)={ |
||
b /= a; |
|||
c /= a; |
|||
===Brent's method=== |
|||
my (delta = b^2 - 4*c, root=sqrt(delta)); |
|||
<syntaxhighlight lang="parigp">solve(x=-.5,.5,x^3-3*x^2+2*x) |
|||
if (delta < 0, |
|||
solve(x=.5,1.5,x^3-3*x^2+2*x) |
|||
[root-b,-root-b]/2 |
|||
solve(x=1.5,2.5,x^3-3*x^2+2*x)</syntaxhighlight> |
|||
, |
|||
my(sol=if(b>0, -b - root,-b + root)/2); |
|||
===Factorization to linear factors=== |
|||
[sol,c/sol] |
|||
<syntaxhighlight lang="parigp">findRoots(P)={ |
|||
my(f=factor(P),t); |
|||
for(i=1,#f[,1], |
|||
if(poldegree(f[i,1]) == 1, |
|||
for(j=1,f[i,2], |
|||
print(-polcoeff(f[i,1], 0), " (exact)") |
|||
) |
|||
); |
|||
if(poldegree(f[i,1]) > 1, |
|||
t=polroots(f[i,1]); |
|||
for(j=1,#t, |
|||
for(k=1,f[i,2], |
|||
print(if(imag(t[j]) == 0.,real(t[j]),t[j]), " (approximate)") |
|||
) |
|||
) |
|||
) |
|||
) |
) |
||
};</syntaxhighlight> |
|||
}; |
|||
findRoots(x^3-3*x^2+2*x)</syntaxhighlight> |
|||
Either way, |
|||
===Factorization to quadratic factors=== |
|||
<syntaxhighlight lang="parigp">roots(1,-1e9,1)</syntaxhighlight> |
|||
Of course this process could be continued to degrees 3 and 4 with sufficient additional work. |
|||
gives one root around 0.000000001000000000000000001 and one root around 999999999.999999999. |
|||
<syntaxhighlight lang="parigp">findRoots(P)={ |
|||
my(f=factor(P),t); |
|||
for(i=1,#f[,1], |
|||
if(poldegree(f[i,1]) == 1, |
|||
for(j=1,f[i,2], |
|||
print(-polcoeff(f[i,1], 0), " (exact)") |
|||
) |
|||
); |
|||
if(poldegree(f[i,1]) == 2, |
|||
t=solveQuadratic(polcoeff(f[i,1],2),polcoeff(f[i,1],1),polcoeff(f[i,1],0)); |
|||
for(j=1,f[i,2], |
|||
print(t[1]" (exact)\n"t[2]" (exact)") |
|||
) |
|||
); |
|||
if(poldegree(f[i,1]) > 2, |
|||
t=polroots(f[i,1]); |
|||
for(j=1,#t, |
|||
for(k=1,f[i,2], |
|||
print(if(imag(t[j]) == 0.,real(t[j]),t[j]), " (approximate)") |
|||
) |
|||
) |
|||
) |
|||
) |
|||
}; |
|||
solveQuadratic(a,b,c)={ |
|||
my(t=-b/2/a,s=b^2/4/a^2-c/a,inner=core(numerator(s))/core(denominator(s)),outer=sqrtint(s/inner)); |
|||
if(inner < 0, |
|||
outer *= I; |
|||
inner *= -1 |
|||
); |
|||
s=if(inner == 1, |
|||
outer |
|||
, |
|||
if(outer == 1, |
|||
Str("sqrt(", inner, ")") |
|||
, |
|||
Str(outer, " * sqrt(", inner, ")") |
|||
) |
|||
); |
|||
if (t, |
|||
[Str(t, " + ", s), Str(t, " - ", s)] |
|||
, |
|||
[s, Str("-", s)] |
|||
) |
|||
}; |
|||
findRoots(x^3-3*x^2+2*x)</syntaxhighlight> |
|||
=={{header|Pascal}}== |
=={{header|Pascal}}== |
||
some parts translated from Modula2 |
|||
{{trans|Fortran}} |
|||
<syntaxhighlight lang="pascal">Program |
<syntaxhighlight lang="pascal">Program QuadraticRoots; |
||
var |
var |
||
a, b, c, q, f: double; |
|||
s: boolean; |
|||
begin |
|||
i, limit: integer; |
|||
a := 1; |
|||
b := -10e9; |
|||
c := 1; |
|||
q := sqrt(a * c) / b; |
|||
f := (1 + sqrt(1 - 4 * q * q)) / 2; |
|||
writeln ('Version 1:'); |
|||
function f(const x: double): double; |
|||
writeln ('x1: ', (-b * f / a):16, ', x2: ', (-c / (b * f)):16); |
|||
begin |
|||
f := x*x*x - 3*x*x + 2*x; |
|||
end; |
|||
writeln ('Version 2:'); |
|||
begin |
|||
q := sqrt(b * b - 4 * a * c); |
|||
if b < 0 then |
|||
e := 1.0e-9; |
|||
s := (f(x) > 0); |
|||
writeln('Version 1: simply stepping x:'); |
|||
while x < 3.0 do |
|||
begin |
begin |
||
f := (-b + q) / 2 * a; |
|||
writeln ('x1: ', f:16, ', x2: ', (c / (a * f)):16); |
|||
if abs(value) < e then |
|||
end |
|||
else |
|||
writeln ('root found at x = ', x); |
|||
s := not s; |
|||
end |
|||
else if ((value > 0) <> s) then |
|||
begin |
|||
writeln ('root found at x = ', x); |
|||
s := not s; |
|||
end; |
|||
x := x + step; |
|||
end; |
|||
writeln('Version 2: secant method:'); |
|||
x1 := -1.0; |
|||
x2 := 3.0; |
|||
e := 1.0e-15; |
|||
i := 1; |
|||
limit := 300; |
|||
while true do |
|||
begin |
begin |
||
f := (-b - q) / 2 * a; |
|||
writeln ('x1: ', (c / (a * f)):16, ', x2: ', f:16); |
|||
begin |
|||
writeln('Error: function not converging'); |
|||
exit; |
|||
end; |
|||
d := (x2 - x1) / (f(x2) - f(x1)) * f(x2); |
|||
if abs(d) < e then |
|||
begin |
|||
if d = 0 then |
|||
write('Exact ') |
|||
else |
|||
write('Approximate '); |
|||
writeln('root found at x = ', x2); |
|||
exit; |
|||
end; |
|||
x1 := x2; |
|||
x2 := x2 - d; |
|||
i := i + 1; |
|||
end; |
end; |
||
end. |
end. |
||
</syntaxhighlight> |
</syntaxhighlight> |
||
{{out}} |
|||
Output: |
|||
<pre> |
<pre> |
||
Version 1 |
Version 1: |
||
x1: 1.00000000E+010, x2: 1.00000000E-010 |
|||
root found at x = 7.91830063542152E-012 |
|||
Version 2: |
|||
root found at x = 1.00000000001584E+000 |
|||
x1: 1.00000000E+010, x2: 1.00000000E-010 |
|||
root found at x = 1.99999999993357E+000 |
|||
Version 2: secant method: |
|||
Exact root found at x = 1.00000000000000E+000 |
|||
</pre> |
</pre> |
||
=={{header|Perl}}== |
=={{header|Perl}}== |
||
When using [http://perldoc.perl.org/Math/Complex.html Math::Complex] perl automatically convert numbers when necessary. |
|||
<syntaxhighlight lang="perl">sub f |
|||
<syntaxhighlight lang="perl">use Math::Complex; |
|||
{ |
|||
my $x = shift; |
|||
($x1,$x2) = solveQuad(1,2,3); |
|||
return ($x * $x * $x - 3*$x*$x + 2*$x); |
|||
} |
|||
print "x1 = $x1, x2 = $x2\n"; |
|||
my $step = 0.001; # Smaller step values produce more accurate and precise results |
|||
my $start = -1; |
|||
my $stop = 3; |
|||
my $value = &f($start); |
|||
my $sign = $value > 0; |
|||
sub solveQuad |
|||
# Check for root at start |
|||
print "Root found at $start\n" if ( 0 == $value ); |
|||
for( my $x = $start + $step; |
|||
$x <= $stop; |
|||
$x += $step ) |
|||
{ |
{ |
||
my ($a,$b,$c) = @_; |
|||
$value = &f($x); |
|||
my $root = sqrt($b**2 - 4*$a*$c); |
|||
return ( -$b + $root )/(2*$a), ( -$b - $root )/(2*$a); |
|||
{ |
|||
# We hit a root |
|||
print "Root found at $x\n"; |
|||
} |
|||
elsif ( ( $value > 0 ) != $sign ) |
|||
{ |
|||
# We passed a root |
|||
print "Root found near $x\n"; |
|||
} |
|||
# Update our sign |
|||
$sign = ( $value > 0 ); |
|||
}</syntaxhighlight> |
}</syntaxhighlight> |
||
=={{header|Phix}}== |
=={{header|Phix}}== |
||
{{trans| |
{{trans|ERRE}} |
||
<!--<syntaxhighlight lang="phix"> |
<!--<syntaxhighlight lang="phix">--> |
||
<span style="color: #008080;">procedure</span> <span style="color: #000000;"> |
<span style="color: #008080;">procedure</span> <span style="color: #000000;">solve_quadratic</span><span style="color: #0000FF;">(</span><span style="color: #004080;">sequence</span> <span style="color: #000000;">t3</span><span style="color: #0000FF;">)</span> |
||
<span style="color: #004080;">atom</span> <span style="color: #0000FF;">{</span><span style="color: #000000;">a</span><span style="color: #0000FF;">,</span><span style="color: #000000;">b</span><span style="color: #0000FF;">,</span><span style="color: #000000;">c</span><span style="color: #0000FF;">}</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">t3</span><span style="color: #0000FF;">,</span> |
|||
<span style="color: #000080;font-style:italic;">-- |
|||
<span style="color: #000000;">d</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">b</span><span style="color: #0000FF;">*</span><span style="color: #000000;">b</span><span style="color: #0000FF;">-</span><span style="color: #000000;">4</span><span style="color: #0000FF;">*</span><span style="color: #000000;">a</span><span style="color: #0000FF;">*</span><span style="color: #000000;">c</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">f</span> |
|||
-- Print approximate roots of f between x=start and x=stop, using |
|||
<span style="color: #004080;">string</span> <span style="color: #000000;">s</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">sprintf</span><span style="color: #0000FF;">(</span><span style="color: #008000;">"for a=%g,b=%g,c=%g"</span><span style="color: #0000FF;">,</span><span style="color: #000000;">t3</span><span style="color: #0000FF;">),</span> <span style="color: #000000;">t</span> |
|||
-- sign changes as an indicator that a root has been encountered. |
|||
<span style="color: #004080;">sequence</span> <span style="color: #000000;">u</span> |
|||
--</span> |
|||
<span style="color: # |
<span style="color: #008080;">if</span> <span style="color: #7060A8;">abs</span><span style="color: #0000FF;">(</span><span style="color: #000000;">d</span><span style="color: #0000FF;">)<</span><span style="color: #000000;">1e-6</span> <span style="color: #008080;">then</span> <span style="color: #000000;">d</span><span style="color: #0000FF;">=</span><span style="color: #000000;">0</span> <span style="color: #008080;">end</span> <span style="color: #008080;">if</span> |
||
<span style="color: # |
<span style="color: #008080;">switch</span> <span style="color: #7060A8;">sign</span><span style="color: #0000FF;">(</span><span style="color: #000000;">d</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">do</span> |
||
<span style="color: #008080;"> |
<span style="color: #008080;">case</span> <span style="color: #000000;">0</span><span style="color: #0000FF;">:</span> <span style="color: #000000;">t</span> <span style="color: #0000FF;">=</span> <span style="color: #008000;">"single root is %g"</span> |
||
<span style="color: # |
<span style="color: #000000;">u</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{-</span><span style="color: #000000;">b</span><span style="color: #0000FF;">/</span><span style="color: #000000;">2</span><span style="color: #0000FF;">/</span><span style="color: #000000;">a</span><span style="color: #0000FF;">}</span> |
||
<span style="color: # |
<span style="color: #008080;">case</span> <span style="color: #000000;">1</span><span style="color: #0000FF;">:</span> <span style="color: #000000;">t</span> <span style="color: #0000FF;">=</span> <span style="color: #008000;">"real roots are %g and %g"</span> |
||
<span style="color: #000000;">f</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">+</span><span style="color: #7060A8;">sqrt</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">-</span><span style="color: #000000;">4</span><span style="color: #0000FF;">*</span><span style="color: #000000;">a</span><span style="color: #0000FF;">*</span><span style="color: #000000;">c</span><span style="color: #0000FF;">/(</span><span style="color: #000000;">b</span><span style="color: #0000FF;">*</span><span style="color: #000000;">b</span><span style="color: #0000FF;">)))/</span><span style="color: #000000;">2</span> |
|||
<span style="color: #008080;">if</span> <span style="color: #000000;">y</span><span style="color: #0000FF;">=</span><span style="color: #000000;">0</span> |
|||
<span style="color: # |
<span style="color: #000000;">u</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{-</span><span style="color: #000000;">f</span><span style="color: #0000FF;">*</span><span style="color: #000000;">b</span><span style="color: #0000FF;">/</span><span style="color: #000000;">a</span><span style="color: #0000FF;">,-</span><span style="color: #000000;">c</span><span style="color: #0000FF;">/</span><span style="color: #000000;">b</span><span style="color: #0000FF;">/</span><span style="color: #000000;">f</span><span style="color: #0000FF;">}</span> |
||
<span style="color: #008080;"> |
<span style="color: #008080;">case</span><span style="color: #0000FF;">-</span><span style="color: #000000;">1</span><span style="color: #0000FF;">:</span> <span style="color: #000000;">t</span> <span style="color: #0000FF;">=</span> <span style="color: #008000;">"complex roots are %g +/- %g*i"</span> |
||
<span style="color: #000000;">u</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{-</span><span style="color: #000000;">b</span><span style="color: #0000FF;">/</span><span style="color: #000000;">2</span><span style="color: #0000FF;">/</span><span style="color: #000000;">a</span><span style="color: #0000FF;">,</span><span style="color: #7060A8;">sqrt</span><span style="color: #0000FF;">(-</span><span style="color: #000000;">d</span><span style="color: #0000FF;">)/</span><span style="color: #000000;">2</span><span style="color: #0000FF;">/</span><span style="color: #000000;">a</span><span style="color: #0000FF;">}</span> |
|||
<span style="color: #008080;">end</span> <span style="color: #008080;">switch</span> |
|||
<span style="color: #000000;"> |
<span style="color: #7060A8;">printf</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"%-25s the %s\n"</span><span style="color: #0000FF;">,{</span><span style="color: #000000;">s</span><span style="color: #0000FF;">,</span><span style="color: #7060A8;">sprintf</span><span style="color: #0000FF;">(</span><span style="color: #000000;">t</span><span style="color: #0000FF;">,</span><span style="color: #000000;">u</span><span style="color: #0000FF;">)})</span> |
||
<span style="color: #008080;">end</span> <span style="color: #008080;">while</span> |
|||
<span style="color: #008080;">end</span> <span style="color: #008080;">procedure</span> |
<span style="color: #008080;">end</span> <span style="color: #008080;">procedure</span> |
||
<span style="color: #008080;">constant</span> <span style="color: #000000;">tests</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{{</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,-</span><span style="color: #000000;">1E9</span><span style="color: #0000FF;">,</span><span style="color: #000000;">1</span><span style="color: #0000FF;">},</span> |
|||
<span style="color: #000080;font-style:italic;">-- Smaller steps produce more accurate/precise results in general, |
|||
<span style="color: #0000FF;">{</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0</span><span style="color: #0000FF;">,</span><span style="color: #000000;">1</span><span style="color: #0000FF;">},</span> |
|||
-- but for many functions we'll never get exact roots, either due |
|||
<span style="color: #0000FF;">{</span><span style="color: #000000;">2</span><span style="color: #0000FF;">,-</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,-</span><span style="color: #000000;">6</span><span style="color: #0000FF;">},</span> |
|||
-- to imperfect binary representation or irrational roots.</span> |
|||
<span style="color: #0000FF;">{</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #000000;">2</span><span style="color: #0000FF;">,-</span><span style="color: #000000;">2</span><span style="color: #0000FF;">},</span> |
|||
<span style="color: #0000FF;">{</span><span style="color: #000000;">0.5</span><span style="color: #0000FF;">,</span><span style="color: #000000;">1.4142135</span><span style="color: #0000FF;">,</span><span style="color: #000000;">1</span><span style="color: #0000FF;">},</span> |
|||
<span style="color: #0000FF;">{</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #000000;">3</span><span style="color: #0000FF;">,</span><span style="color: #000000;">2</span><span style="color: #0000FF;">},</span> |
|||
<span style="color: #0000FF;">{</span><span style="color: #000000;">3</span><span style="color: #0000FF;">,</span><span style="color: #000000;">4</span><span style="color: #0000FF;">,</span><span style="color: #000000;">5</span><span style="color: #0000FF;">}}</span> |
|||
<span style="color: # |
<span style="color: #7060A8;">papply</span><span style="color: #0000FF;">(</span><span style="color: #000000;">tests</span><span style="color: #0000FF;">,</span><span style="color: #000000;">solve_quadratic</span><span style="color: #0000FF;">)</span> |
||
<span style="color: #008080;">function</span> <span style="color: #000000;">f2</span><span style="color: #0000FF;">(</span><span style="color: #004080;">atom</span> <span style="color: #000000;">x</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">return</span> <span style="color: #000000;">x</span><span style="color: #0000FF;">*</span><span style="color: #000000;">x</span><span style="color: #0000FF;">-</span><span style="color: #000000;">4</span><span style="color: #0000FF;">*</span><span style="color: #000000;">x</span><span style="color: #0000FF;">+</span><span style="color: #000000;">3</span> <span style="color: #008080;">end</span> <span style="color: #008080;">function</span> |
|||
<span style="color: #008080;">function</span> <span style="color: #000000;">f3</span><span style="color: #0000FF;">(</span><span style="color: #004080;">atom</span> <span style="color: #000000;">x</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">return</span> <span style="color: #000000;">x</span><span style="color: #0000FF;">-</span><span style="color: #000000;">1.5</span> <span style="color: #008080;">end</span> <span style="color: #008080;">function</span> |
|||
<span style="color: #008080;">function</span> <span style="color: #000000;">f4</span><span style="color: #0000FF;">(</span><span style="color: #004080;">atom</span> <span style="color: #000000;">x</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">return</span> <span style="color: #000000;">x</span><span style="color: #0000FF;">*</span><span style="color: #000000;">x</span><span style="color: #0000FF;">-</span><span style="color: #000000;">2</span> <span style="color: #008080;">end</span> <span style="color: #008080;">function</span> |
|||
<span style="color: #000000;">print_roots</span><span style="color: #0000FF;">(</span><span style="color: #000000;">f1</span><span style="color: #0000FF;">,</span> <span style="color: #0000FF;">-</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">5</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">step</span><span style="color: #0000FF;">)</span> |
|||
<span style="color: #000000;">print_roots</span><span style="color: #0000FF;">(</span><span style="color: #000000;">f2</span><span style="color: #0000FF;">,</span> <span style="color: #0000FF;">-</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">5</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">step</span><span style="color: #0000FF;">)</span> |
|||
<span style="color: #000000;">print_roots</span><span style="color: #0000FF;">(</span><span style="color: #000000;">f3</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">0</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">4</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">step</span><span style="color: #0000FF;">)</span> |
|||
<span style="color: #000000;">print_roots</span><span style="color: #0000FF;">(</span><span style="color: #000000;">f4</span><span style="color: #0000FF;">,</span> <span style="color: #0000FF;">-</span><span style="color: #000000;">2</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">2</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">step</span><span style="color: #0000FF;">)</span> |
|||
<!--</syntaxhighlight>--> |
<!--</syntaxhighlight>--> |
||
{{out}} |
|||
<pre> |
<pre> |
||
for a=1,b=-1e+9,c=1 the real roots are 1e+9 and 1e-9 |
|||
----- |
|||
for a=1,b=0,c=1 the complex roots are 0 +/- 1*i |
|||
Root found at 0 |
|||
for a=2,b=-1,c=-6 the real roots are 2 and -1.5 |
|||
Root found at 1 |
|||
for a=1,b=2,c=-2 the real roots are -2.73205 and 0.732051 |
|||
Root found at 2 |
|||
for a=0.5,b=1.41421,c=1 the single root is -1.41421 |
|||
----- |
|||
for a=1,b=3,c=2 the real roots are -2 and -1 |
|||
Root found at 1 |
|||
for a=3,b=4,c=5 the complex roots are -0.666667 +/- 1.10554*i |
|||
Root found at 3 |
|||
----- |
|||
Root found at 1.5 |
|||
----- |
|||
Root found near -1.4140625 |
|||
Root found near 1.41796875 |
|||
</pre> |
</pre> |
||
=={{header|PicoLisp}}== |
=={{header|PicoLisp}}== |
||
<syntaxhighlight lang="picolisp">(scl 40) |
|||
{{trans|Clojure}} |
|||
<syntaxhighlight lang="picolisp">(de findRoots (F Start Stop Step Eps) |
|||
(filter |
|||
'((N) (> Eps (abs (F N)))) |
|||
(range Start Stop Step) ) ) |
|||
(de solveQuad (A B C) |
|||
(scl 12) |
|||
(let SD (sqrt (- (* B B) (* 4 A C))) |
|||
(if (lt0 B) |
|||
(list |
|||
(*/ (- SD B) A 2.0) |
|||
(*/ C 2.0 (*/ A A (- SD B) `(* 1.0 1.0))) ) |
|||
(list |
|||
(*/ C 2.0 (*/ A A (- 0 B SD) `(* 1.0 1.0))) |
|||
(*/ (- 0 B SD) A 2.0) ) ) ) ) |
|||
(mapcar round |
(mapcar round |
||
(solveQuad 1.0 -1000000.0 1.0) |
|||
(findRoots |
|||
(6 .) )</syntaxhighlight> |
|||
'((X) (+ (*/ X X X `(* 1.0 1.0)) (*/ -3 X X 1.0) (* 2 X))) |
|||
{{out}} |
|||
-1.0 3.0 0.0001 0.00000001 ) )</syntaxhighlight> |
|||
<pre>-> ("999,999.999999" "0.000001")</pre> |
|||
Output: |
|||
<pre>-> ("0.000" "1.000" "2.000")</pre> |
|||
=={{header|PL/I}}== |
=={{header|PL/I}}== |
||
<syntaxhighlight lang="pl/i"> |
<syntaxhighlight lang="pl/i"> |
||
declare (c1, c2) float complex, |
|||
(a, b, c, x1, x2) float; |
|||
return (x**3 - 3*x**2 + 2*x ); |
|||
end f; |
|||
get list (a, b, c); |
|||
if b**2 < 4*a*c then |
|||
declare dx fixed decimal (15,13); |
|||
do; |
|||
c1 = (-b + sqrt(b**2 - 4+0i*a*c)) / (2*a); |
|||
c2 = (-b - sqrt(b**2 - 4+0i*a*c)) / (2*a); |
|||
put data (c1, c2); |
|||
end; |
|||
else |
|||
do; |
|||
x1 = (-b + sqrt(b**2 - 4*a*c)) / (2*a); |
|||
x2 = (-b - sqrt(b**2 - 4*a*c)) / (2*a); |
|||
put data (x1, x2); |
|||
end; |
|||
</syntaxhighlight> |
|||
=={{header|Python}}== |
|||
eps = 1e-12; |
|||
{{libheader|NumPy}} |
|||
This solution compares the naïve method with three "better" methods. |
|||
<syntaxhighlight lang="python">#!/usr/bin/env python3 |
|||
import math |
|||
do dx = -5.03 to 5 by 0.1; |
|||
import cmath |
|||
x = dx; |
|||
import numpy |
|||
if sign(f(x)) ^= sign(f(dx+0.1)) then |
|||
call locate_root; |
|||
end; |
|||
def quad_discriminating_roots(a,b,c, entier = 1e-5): |
|||
locate_root: procedure; |
|||
"""For reference, the naive algorithm which shows complete loss of |
|||
declare (left, mid, right) float (18); |
|||
precision on the quadratic in question. (This function also returns a |
|||
characterization of the roots.)""" |
|||
discriminant = b*b - 4*a*c |
|||
a,b,c,d =complex(a), complex(b), complex(c), complex(discriminant) |
|||
root1 = (-b + cmath.sqrt(d))/2./a |
|||
root2 = (-b - cmath.sqrt(d))/2./a |
|||
if abs(discriminant) < entier: |
|||
return "real and equal", abs(root1), abs(root1) |
|||
if discriminant > 0: |
|||
return "real", root1.real, root2.real |
|||
return "complex", root1, root2 |
|||
def middlebrook(a, b, c): |
|||
put skip list ('Looking for root in [' || x, x+0.1 || ']' ); |
|||
try: |
|||
left = x; right = dx+0.1; |
|||
q = math.sqrt(a*c)/b |
|||
PUT SKIP LIST (F(LEFT), F(RIGHT) ); |
|||
f = .5+ math.sqrt(1-4*q*q)/2 |
|||
if abs(f(left) ) < eps then |
|||
except ValueError: |
|||
do; put skip list ('Found a root at x=', left); return; end; |
|||
q = cmath.sqrt(a*c)/b |
|||
else if abs(f(right) ) < eps then |
|||
f = .5+ cmath.sqrt(1-4*q*q)/2 |
|||
do; put skip list ('Found a root at x=', right); return; end; |
|||
return (-b/a)*f, -c/(b*f) |
|||
do forever; |
|||
mid = (left+right)/2; |
|||
if sign(f(mid)) = 0 then |
|||
do; put skip list ('Root found at x=', mid); return; end; |
|||
else if sign(f(left)) ^= sign(f(mid)) then |
|||
right = mid; |
|||
else |
|||
left = mid; |
|||
/* put skip list (left || right); */ |
|||
if abs(right-left) < eps then |
|||
do; put skip list ('There is a root near ' || |
|||
(left+right)/2); return; |
|||
end; |
|||
end; |
|||
end locate_root; |
|||
</syntaxhighlight> |
|||
def whatevery(a, b, c): |
|||
=={{header|PureBasic}}== |
|||
try: |
|||
{{trans|C++}} |
|||
d = math.sqrt(b*b-4*a*c) |
|||
<syntaxhighlight lang="purebasic">Procedure.d f(x.d) |
|||
except ValueError: |
|||
ProcedureReturn x*x*x-3*x*x+2*x |
|||
d = cmath.sqrt(b*b-4*a*c) |
|||
EndProcedure |
|||
if b > 0: |
|||
return div(2*c, (-b-d)), div((-b-d), 2*a) |
|||
else: |
|||
return div((-b+d), 2*a), div(2*c, (-b+d)) |
|||
def div(n, d): |
|||
Procedure main() |
|||
"""Divide, with a useful interpretation of division by zero.""" |
|||
OpenConsole() |
|||
try: |
|||
Define.d StepSize= 0.001 |
|||
return n/d |
|||
Define.d Start=-1, stop=3 |
|||
except ZeroDivisionError: |
|||
Define.d value=f(start), x=start |
|||
if n: |
|||
Define.i oldsign=Sign(value) |
|||
return n*float('inf') |
|||
return float('nan') |
|||
If value=0 |
|||
PrintN("Root found at "+StrF(start)) |
|||
EndIf |
|||
While x<=stop |
|||
value=f(x) |
|||
If Sign(value) <> oldsign |
|||
PrintN("Root found near "+StrF(x)) |
|||
ElseIf value = 0 |
|||
PrintN("Root found at "+StrF(x)) |
|||
EndIf |
|||
oldsign=Sign(value) |
|||
x+StepSize |
|||
Wend |
|||
EndProcedure |
|||
testcases = [ |
|||
main()</syntaxhighlight> |
|||
(3, 4, 4/3), # real, equal |
|||
(3, 2, -1), # real, unequal |
|||
(3, 2, 1), # complex |
|||
(1, -1e9, 1), # ill-conditioned "quadratic in question" required by task. |
|||
(1, -1e100, 1), |
|||
(1, -1e200, 1), |
|||
(1, -1e300, 1), |
|||
] |
|||
print('Naive:') |
|||
=={{header|Python}}== |
|||
for c in testcases: |
|||
{{trans|Perl}} |
|||
print("{} {:.5} {:.5}".format(*quad_discriminating_roots(*c))) |
|||
<syntaxhighlight lang="python">f = lambda x: x * x * x - 3 * x * x + 2 * x |
|||
print('\nMiddlebrook:') |
|||
step = 0.001 # Smaller step values produce more accurate and precise results |
|||
for c in testcases: |
|||
start = -1 |
|||
print(("{:.5} "*2).format(*middlebrook(*c))) |
|||
stop = 3 |
|||
print('\nWhat Every...') |
|||
sign = f(start) > 0 |
|||
for c in testcases: |
|||
print(("{:.5} "*2).format(*whatevery(*c))) |
|||
print('\nNumpy:') |
|||
x = start |
|||
for c in testcases: |
|||
while x <= stop: |
|||
print(("{:.5} "*2).format(*numpy.roots(c)))</syntaxhighlight> |
|||
value = f(x) |
|||
{{out}} |
|||
<pre> |
|||
Naive: |
|||
real and equal 0.66667 0.66667 |
|||
real 0.33333 -1.0 |
|||
complex (-0.33333+0.4714j) (-0.33333-0.4714j) |
|||
real 1e+09 0.0 |
|||
real 1e+100 0.0 |
|||
real nan nan |
|||
real nan nan |
|||
Middlebrook: |
|||
if value == 0: |
|||
-0.66667 -0.66667 |
|||
# We hit a root |
|||
(-1+0j) (0.33333+0j) |
|||
print "Root found at", x |
|||
(-0.33333-0.4714j) (-0.33333+0.4714j) |
|||
elif (value > 0) != sign: |
|||
1e+09 1e-09 |
|||
# We passed a root |
|||
1e+100 1e-100 |
|||
print "Root found near", x |
|||
1e+200 1e-200 |
|||
1e+300 1e-300 |
|||
What Every... |
|||
# Update our sign |
|||
-0.66667 -0.66667 |
|||
sign = value > 0 |
|||
0.33333 -1.0 |
|||
(-0.33333+0.4714j) (-0.33333-0.4714j) |
|||
1e+09 1e-09 |
|||
1e+100 1e-100 |
|||
inf 0.0 |
|||
inf 0.0 |
|||
Numpy: |
|||
x += step</syntaxhighlight> |
|||
-0.66667 -0.66667 |
|||
-1.0 0.33333 |
|||
(-0.33333+0.4714j) (-0.33333-0.4714j) |
|||
1e+09 1e-09 |
|||
1e+100 1e-100 |
|||
1e+200 1e-200 |
|||
1e+300 0.0 |
|||
</pre> |
|||
=={{header|R}}== |
=={{header|R}}== |
||
<syntaxhighlight lang="r">qroots <- function(a, b, c) { |
|||
{{trans|Octave}} |
|||
r <- sqrt(b * b - 4 * a * c + 0i) |
|||
if (abs(b - r) > abs(b + r)) { |
|||
z <- (-b + r) / (2 * a) |
|||
findroots <- function(f, begin, end, tol = 1e-20, step = 0.001) { |
|||
} else { |
|||
se <- ifelse(sign(f(begin))==0, 1, sign(f(begin))) |
|||
z <- (-b - r) / (2 * a) |
|||
while ( x <= end ) { |
|||
v <- f(x) |
|||
if ( abs(v) < tol ) { |
|||
print(sprintf("root at %f", x)) |
|||
} else if ( ifelse(sign(v)==0, 1, sign(v)) != se ) { |
|||
print(sprintf("root near %f", x)) |
|||
} |
|||
se <- ifelse( sign(v) == 0 , 1, sign(v)) |
|||
x <- x + step |
|||
} |
} |
||
c(z, c / (z * a)) |
|||
} |
} |
||
qroots(1, 0, 2i) |
|||
findroots(f, -1, 3)</syntaxhighlight> |
|||
[1] -1+1i 1-1i |
|||
qroots(1, -1e9, 1) |
|||
=={{header|Racket}}== |
|||
[1] 1e+09+0i 1e-09+0i</syntaxhighlight> |
|||
Using the builtin '''polyroot''' function (note the order of coefficients is reversed): |
|||
<syntaxhighlight lang="racket"> |
|||
#lang racket |
|||
<syntaxhighlight lang="r">polyroot(c(2i, 0, 1)) |
|||
;; Attempts to find all roots of a real-valued function f |
|||
[1] -1+1i 1-1i |
|||
;; in a given interval [a b] by dividing the interval into N parts |
|||
;; and using the root-finding method on each subinterval |
|||
;; which proves to contain a root. |
|||
(define (find-roots f a b |
|||
#:divisions [N 10] |
|||
#:method [method secant]) |
|||
(define h (/ (- b a) N)) |
|||
(for*/list ([x1 (in-range a b h)] |
|||
[x2 (in-value (+ x1 h))] |
|||
#:when (or (root? f x1) |
|||
(includes-root? f x1 x2))) |
|||
(find-root f x1 x2 #:method method))) |
|||
polyroot(c(1, -1e9, 1)) |
|||
;; Finds a root of a real-valued function f |
|||
[1] 1e-09+0i 1e+09+0i</syntaxhighlight> |
|||
;; in a given interval [a b]. |
|||
(define (find-root f a b #:method [method secant]) |
|||
(cond |
|||
[(root? f a) a] |
|||
[(root? f b) b] |
|||
[else (and (includes-root? f a b) (method f a b))])) |
|||
=={{header|Racket}}== |
|||
;; Returns #t if x is a root of a real-valued function f |
|||
<syntaxhighlight lang="racket">#lang racket |
|||
;; with absolute accuracy (tolerance). |
|||
(define ( |
(define (quadratic a b c) |
||
(let* ((-b (- b)) |
|||
(delta (- (expt b 2) (* 4 a c))) |
|||
(denominator (* 2 a))) |
|||
(list |
|||
(/ (+ -b (sqrt delta)) denominator) |
|||
(/ (- -b (sqrt delta)) denominator)))) |
|||
;(quadratic 1 0.0000000000001 -1) |
|||
;; Returns #t if interval (a b) contains a root |
|||
;'(0.99999999999995 -1.00000000000005) |
|||
;; (or the odd number of roots) of a real-valued function f. |
|||
;(quadratic 1 0.0000000000001 1) |
|||
(define (includes-root? f a b) (< (* (f a) (f b)) 0)) |
|||
;'(-5e-014+1.0i -5e-014-1.0i)</syntaxhighlight> |
|||
=={{header|Raku}}== |
|||
;; Returns #t if a and b are equal with respect to |
|||
(formerly Perl 6) |
|||
;; the relative accuracy (tolerance). |
|||
(define (almost-equal? a b) |
|||
(or (< (abs (+ b a)) (tolerance)) |
|||
(< (abs (/ (- b a) (+ b a))) (tolerance)))) |
|||
{{Works with|Rakudo|2022.12}} |
|||
(define tolerance (make-parameter 5e-16)) |
|||
</syntaxhighlight> |
|||
''Works with previous versions also but will return slightly less precise results.'' |
|||
Different root-finding methods |
|||
Raku has complex number handling built in. |
|||
<syntaxhighlight lang="racket"> |
|||
(define (secant f a b) |
|||
(let next ([x1 a] [y1 (f a)] [x2 b] [y2 (f b)] [n 50]) |
|||
(define x3 (/ (- (* x1 y2) (* x2 y1)) (- y2 y1))) |
|||
(cond |
|||
; if the method din't converge within given interval |
|||
; switch to more robust bisection method |
|||
[(or (not (< a x3 b)) (zero? n)) (bisection f a b)] |
|||
[(almost-equal? x3 x2) x3] |
|||
[else (next x2 y2 x3 (f x3) (sub1 n))]))) |
|||
<syntaxhighlight lang="raku" line>for |
|||
(define (bisection f x1 x2) |
|||
[1, 2, 1], |
|||
(let divide ([a x1] [b x2]) |
|||
[1, 2, 3], |
|||
(and (<= (* (f a) (f b)) 0) |
|||
[1, -2, 1], |
|||
(let ([c (* 0.5 (+ a b))]) |
|||
[1, 0, -4], |
|||
(if (almost-equal? a b) |
|||
[1, -10⁶, 1] |
|||
c |
|||
-> @coefficients { |
|||
(or (divide a c) (divide c b))))))) |
|||
printf "Roots for %d, %d, %d\t=> (%s, %s)\n", |
|||
</syntaxhighlight> |
|||
|@coefficients, |quadroots(@coefficients); |
|||
} |
|||
sub quadroots (*[$a, $b, $c]) { |
|||
Examples: |
|||
( -$b + $_ ) / (2 × $a), |
|||
<syntaxhighlight lang="racket"> |
|||
( -$b - $_ ) / (2 × $a) |
|||
given |
|||
1.414213562373095 |
|||
($b² - 4 × $a × $c ).Complex.sqrt.narrow |
|||
-> (sqrt 2) |
|||
}</syntaxhighlight> |
|||
1.4142135623730951 |
|||
{{out}} |
|||
<pre>Roots for 1, 2, 1 => (-1, -1) |
|||
Roots for 1, 2, 3 => (-1+1.4142135623730951i, -1-1.4142135623730951i) |
|||
Roots for 1, -2, 1 => (1, 1) |
|||
Roots for 1, 0, -4 => (2, -2) |
|||
Roots for 1, -1000000, 1 => (999999.999999, 1.00000761449337e-06)</pre> |
|||
=={{header|REXX}}== |
|||
-> (define (f x) (+ (* x x x) (* -3.0 x x) (* 2.0 x))) |
|||
===version 1=== |
|||
-> (find-roots f -3 4 #:divisions 50) |
|||
The REXX language doesn't have a '''sqrt''' function, nor does it support complex numbers natively. |
|||
'(2.4932181969624796e-33 1.0 2.0) |
|||
</syntaxhighlight> |
|||
Since "unlimited" decimal precision is part of the REXX language, the '''numeric digits''' was increased |
|||
In order to provide a comprehensive code the given solution does not optimize the number of function calls. |
|||
<br>(from a default of '''9''') to '''200''' to accommodate when a root is closer to zero than the other root. |
|||
The functional nature of Racket allows to perform the optimization without changing the main code using memoization. |
|||
Note that only nine decimal digits (precision) are shown in the ''displaying'' of the output. |
|||
Simple memoization operator |
|||
<syntaxhighlight lang="racket"> |
|||
(define (memoized f) |
|||
(define tbl (make-hash)) |
|||
(λ x |
|||
(cond [(hash-ref tbl x #f) => values] |
|||
[else (define res (apply f x)) |
|||
(hash-set! tbl x res) |
|||
res]))) |
|||
</syntaxhighlight> |
|||
This REXX version supports ''complex numbers'' for the result. |
|||
To use memoization just call |
|||
<syntaxhighlight lang=" |
<syntaxhighlight lang="rexx">/*REXX program finds the roots (which may be complex) of a quadratic function. */ |
||
parse arg a b c . /*obtain the specified arguments: A B C*/ |
|||
-> (find-roots (memoized f) -3 4 #:divisions 50) |
|||
call quad a,b,c /*solve quadratic function via the sub.*/ |
|||
'(2.4932181969624796e-33 1.0 2.0) |
|||
r1= r1/1; r2= r2/1; a= a/1; b= b/1; c= c/1 /*normalize numbers to a new precision.*/ |
|||
</syntaxhighlight> |
|||
if r1j\=0 then r1=r1||left('+',r1j>0)(r1j/1)"i" /*Imaginary part? Handle complex number*/ |
|||
if r2j\=0 then r2=r2||left('+',r2j>0)(r2j/1)"i" /* " " " " " */ |
|||
say ' a =' a /*display the normalized value of A. */ |
|||
say ' b =' b /* " " " " " B. */ |
|||
say ' c =' c /* " " " " " C. */ |
|||
say; say 'root1 =' r1 /* " " " " 1st root*/ |
|||
say 'root2 =' r2 /* " " " " 2nd root*/ |
|||
exit 0 /*stick a fork in it, we're all done. */ |
|||
/*──────────────────────────────────────────────────────────────────────────────────────*/ |
|||
quad: parse arg aa,bb,cc; numeric digits 200 /*obtain 3 args; use enough dec. digits*/ |
|||
$= sqrt(bb**2-4*aa*cc); L= length($) /*compute SQRT (which may be complex).*/ |
|||
r= 1 /(aa+aa); ?= right($, 1)=='i' /*compute reciprocal of 2*aa; Complex?*/ |
|||
if ? then do; r1= -bb *r; r2=r1; r1j= left($,L-1)*r; r2j=-r1j; end |
|||
else do; r1=(-bb+$)*r; r2=(-bb-$)*r; r1j= 0; r2j= 0; end |
|||
return |
|||
/*──────────────────────────────────────────────────────────────────────────────────────*/ |
|||
sqrt: procedure; parse arg x 1 ox; if x=0 then return 0; d= digits(); m.= 9; numeric form |
|||
numeric digits 9; h= d+6; x=abs(x); parse value format(x,2,1,,0) 'E0' with g 'E' _ . |
|||
g=g*.5'e'_%2; do j=0 while h>9; m.j=h; h=h%2+1; end /*j*/ |
|||
do k=j+5 to 0 by -1; numeric digits m.k; g=(g+x/g)*.5; end /*k*/ |
|||
numeric digits d; return (g/1)left('i', ox<0) /*make complex if OX<0. */</syntaxhighlight> |
|||
{{out|output|text= when using the input of: <tt> 1 -10e5 1 </tt>}} |
|||
<pre> |
|||
a = 1 |
|||
b = -1000000 |
|||
c = 1 |
|||
root1 = 1000000 |
|||
The profiling shows that memoization reduces the number of function calls |
|||
root2 = 0.000001 |
|||
in this example from 184 to 67 (50 calls for primary interval division and about 6 calls for each point refinement). |
|||
</pre> |
|||
The following output is when Regina 3.9.3 REXX is used. |
|||
{{out|output|text= when using the input of: <tt> 1 -10e9 1 </tt>}} |
|||
=={{header|Raku}}== |
|||
<pre> |
|||
(formerly Perl 6) |
|||
a = 1 |
|||
Uses exact arithmetic. |
|||
b = -1.0E+10 |
|||
<syntaxhighlight lang="raku" line>sub f(\x) { x³ - 3*x² + 2*x } |
|||
c = 1 |
|||
root1 = 1.000000000E+10 |
|||
my $start = -1; |
|||
root2 = 1E-10 |
|||
my $stop = 3; |
|||
</pre> |
|||
my $step = 0.001; |
|||
The following output is when R4 REXX is used. |
|||
{{out|output|text= when using the input of: <tt> 1 -10e9 1 </tt>}} |
|||
for $start, * + $step ... $stop -> $x { |
|||
<pre> |
|||
state $sign = 0; |
|||
a = 1 |
|||
b = -1E+10 |
|||
c = 1 |
|||
say "Root found at $x"; |
|||
} |
|||
when $sign and $next != $sign { |
|||
say "Root found near $x"; |
|||
} |
|||
NEXT $sign = $next; |
|||
} |
|||
}</syntaxhighlight> |
|||
{{out}} |
|||
<pre>Root found at 0 |
|||
Root found at 1 |
|||
Root found at 2</pre> |
|||
root1 = 1E+10 |
|||
=={{header|REXX}}== |
|||
root2 = 0.0000000001 |
|||
Both of these REXX versions use the '''bisection method'''. |
|||
</pre> |
|||
===function coded as a REXX function=== |
|||
{{out|output|text= when using the input of: <tt> 3 2 1 </tt>}} |
|||
<syntaxhighlight lang="rexx">/*REXX program finds the roots of a specific function: x^3 - 3*x^2 + 2*x via bisection*/ |
|||
parse arg bot top inc . /*obtain optional arguments from the CL*/ |
|||
if bot=='' | bot=="," then bot= -5 /*Not specified? Then use the default.*/ |
|||
if top=='' | top=="," then top= +5 /* " " " " " " */ |
|||
if inc=='' | inc=="," then inc= .0001 /* " " " " " " */ |
|||
z= f(bot - inc) /*compute 1st value to start compares. */ |
|||
!= sign(z) /*obtain the sign of the initial value.*/ |
|||
do j=bot to top by inc /*traipse through the specified range. */ |
|||
z= f(j); $= sign(z) /*compute new value; obtain the sign. */ |
|||
if z=0 then say 'found an exact root at' j/1 |
|||
else if !\==$ then if !\==0 then say 'passed a root at' j/1 |
|||
!= $ /*use the new sign for the next compare*/ |
|||
end /*j*/ /*dividing by unity normalizes J [↑] */ |
|||
exit /*stick a fork in it, we're all done. */ |
|||
/*──────────────────────────────────────────────────────────────────────────────────────*/ |
|||
f: parse arg x; return x * (x * (x-3) +2) /*formula used ──► x^3 - 3x^2 + 2x */ |
|||
/*with factoring ──► x{ x^2 -3x + 2 } */ |
|||
/*more " ──► x{ x( x-3 ) + 2 } */</syntaxhighlight> |
|||
{{out|output|text= when using the defaults for input:}} |
|||
<pre> |
<pre> |
||
a = 3 |
|||
found an exact root at 0 |
|||
b = 2 |
|||
found an exact root at 1 |
|||
c = 1 |
|||
found an exact root at 2 |
|||
root1 = -0.333333333+0.471404521i |
|||
root2 = -0.333333333-0.471404521i |
|||
</pre> |
</pre> |
||
{{out|output|text= when using the input of: <tt> 1 0 1 </tt> |
|||
<pre> |
|||
a = 1 |
|||
b = 0 |
|||
c = 1 |
|||
root1 = 0+1i |
|||
===function coded in-line=== |
|||
root2 = 0-1i |
|||
This version is about '''40%''' faster than the 1<sup>st</sup> REXX version. |
|||
</pre> |
|||
<syntaxhighlight lang="rexx">/*REXX program finds the roots of a specific function: x^3 - 3*x^2 + 2*x via bisection*/ |
|||
parse arg bot top inc . /*obtain optional arguments from the CL*/ |
|||
if bot=='' | bot=="," then bot= -5 /*Not specified? Then use the default.*/ |
|||
if top=='' | top=="," then top= +5 /* " " " " " " */ |
|||
if inc=='' | inc=="," then inc= .0001 /* " " " " " " */ |
|||
x= bot - inc /*compute 1st value to start compares. */ |
|||
z= x * (x * (x-3) + 2) /*formula used ──► x^3 - 3x^2 + 2x */ |
|||
!= sign(z) /*obtain the sign of the initial value.*/ |
|||
do x=bot to top by inc /*traipse through the specified range. */ |
|||
z= x * (x * (x-3) + 2); $= sign(z) /*compute new value; obtain the sign. */ |
|||
if z=0 then say 'found an exact root at' x/1 |
|||
else if !\==$ then if !\==0 then say 'passed a root at' x/1 |
|||
!= $ /*use the new sign for the next compare*/ |
|||
end /*x*/ /*dividing by unity normalizes X [↑] */</syntaxhighlight> |
|||
{{out|output|text= is the same as the 1<sup>st</sup> REXX version.}} <br><br> |
|||
== |
=== Version 2 === |
||
<syntaxhighlight lang=" |
<syntaxhighlight lang="rexx">/* REXX *************************************************************** |
||
* 26.07.2913 Walter Pachl |
|||
load "stdlib.ring" |
|||
**********************************************************************/ |
|||
function = "return pow(x,3)-3*pow(x,2)+2*x" |
|||
Numeric Digits 30 |
|||
rangemin = -1 |
|||
Parse Arg a b c 1 alist |
|||
rangemax = 3 |
|||
Select |
|||
stepsize = 0.001 |
|||
When a='' | a='?' Then |
|||
accuracy = 0.1 |
|||
Call exit 'rexx qgl a b c solves a*x**2+b*x+c' |
|||
roots(function, rangemin, rangemax, stepsize, accuracy) |
|||
When words(alist)<>3 Then |
|||
Call exit 'three numbers are required' |
|||
func roots funct, min, max, inc, eps |
|||
Otherwise |
|||
Nop |
|||
for x = min to max step inc |
|||
End |
|||
num = sign(eval(funct)) |
|||
gl=a'*x**2' |
|||
if num = 0 |
|||
Select |
|||
see "root found at x = " + x + nl |
|||
When b<0 Then gl=gl||b'*x' |
|||
When b>0 Then gl=gl||'+'||b'*x' |
|||
else if num != oldsign and oldsign != 0 |
|||
Otherwise Nop |
|||
if inc < eps |
|||
End |
|||
see "root found near x = " + x + nl |
|||
Select |
|||
else roots(funct, x-inc, x+inc/8, inc/8, eps) ok ok ok |
|||
When c<0 Then gl=gl||c |
|||
When c>0 Then gl=gl||'+'||c |
|||
next |
|||
Otherwise Nop |
|||
</syntaxhighlight> |
|||
End |
|||
Output: |
|||
Say gl '= 0' |
|||
d=b**2-4*a*c |
|||
If d<0 Then Do |
|||
dd=sqrt(-d) |
|||
r=-b/(2*a) |
|||
i=dd/(2*a) |
|||
x1=r'+'i'i' |
|||
x2=r'-'i'i' |
|||
End |
|||
Else Do |
|||
dd=sqrt(d) |
|||
x1=(-b+dd)/(2*a) |
|||
x2=(-b-dd)/(2*a) |
|||
End |
|||
Say 'x1='||x1 |
|||
Say 'x2='||x2 |
|||
Exit |
|||
sqrt: |
|||
/* REXX *************************************************************** |
|||
* EXEC to calculate the square root of x with high precision |
|||
**********************************************************************/ |
|||
Parse Arg x |
|||
prec=digits() |
|||
prec1=2*prec |
|||
eps=10**(-prec1) |
|||
k = 1 |
|||
Numeric Digits prec1 |
|||
r0= x |
|||
r = 1 |
|||
Do i=1 By 1 Until r=r0 | (abs(r*r-x)<eps) |
|||
r0 = r |
|||
r = (r + x/r) / 2 |
|||
k = min(prec1,2*k) |
|||
Numeric Digits (k + 5) |
|||
End |
|||
Numeric Digits prec |
|||
Return (r+0) |
|||
exit: Say arg(1) |
|||
Exit</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
<pre> |
||
Version 1: |
|||
root found near x = 0.00 |
|||
a = 1 |
|||
b = -1 |
|||
c = 0 |
|||
</pre> |
|||
root1 = 1 |
|||
=={{header|RLaB}}== |
|||
root2 = 0 |
|||
RLaB implements a number of solvers from the GSL and the netlib that find the roots of a real or vector function of a real or vector variable. |
|||
The solvers are grouped with respect whether the variable is a scalar, ''findroot'', or a vector, ''findroots''. Furthermore, for each group there are two types of solvers, one that does not require the derivative of the objective function (which root(s) are being sought), and one that does. |
|||
Version 2: |
|||
The script that finds a root of a scalar function <math>f(x) = x^3-3\,x^2 + 2\,x</math> of a scalar variable ''x'' |
|||
1*x**2-1.0000000001*x+1.e-9 = 0 |
|||
using the bisection method on the interval -5 to 5 is, |
|||
x1=0.9999999991000000000025 |
|||
<syntaxhighlight lang="rlab"> |
|||
x2=0.0000000009999999999975 |
|||
f = function(x) |
|||
</pre> |
|||
{ |
|||
rval = x .^ 3 - 3 * x .^ 2 + 2 * x; |
|||
=={{header|Ring}}== |
|||
return rval; |
|||
<syntaxhighlight lang="text"> |
|||
}; |
|||
x1 = 0 |
|||
x2 = 0 |
|||
quadratic(3, 4, 4/3.0) # [-2/3] |
|||
see "x1 = " + x1 + " x2 = " + x2 + nl |
|||
quadratic(3, 2, -1) # [1/3, -1] |
|||
see "x1 = " + x1 + " x2 = " + x2 + nl |
|||
quadratic(-2, 7, 15) # [-3/2, 5] |
|||
see "x1 = " + x1 + " x2 = " + x2 + nl |
|||
quadratic(1, -2, 1) # [1] |
|||
see "x1 = " + x1 + " x2 = " + x2 + nl |
|||
func quadratic a, b, c |
|||
>> findroot(f, , [-5,5]) |
|||
sqrtDiscriminant = sqrt(pow(b,2) - 4*a*c) |
|||
0 |
|||
x1 = (-b + sqrtDiscriminant) / (2.0*a) |
|||
x2 = (-b - sqrtDiscriminant) / (2.0*a) |
|||
return [x1, x2] |
|||
</syntaxhighlight> |
</syntaxhighlight> |
||
=={{header|RPL}}== |
|||
For a detailed description of the solver and its parameters interested reader is directed to the ''rlabplus'' manual. |
|||
RPL can solve quadratic functions directly : |
|||
'x^2-1E9*x+1' 'x' QUAD |
|||
returns |
|||
1: '(1000000000+s1*1000000000)/2' |
|||
which can then be turned into roots by storing 1 or -1 in the <code>s1</code> variable and evaluating the formula: |
|||
DUP 1 's1' STO EVAL SWAP -1 's1' STO EVAL |
|||
hence returning |
|||
2: 1000000000 |
|||
1: 0 |
|||
So let's implement the algorithm proposed by the task: |
|||
{| class="wikitable" |
|||
! RPL code |
|||
! Comment |
|||
|- |
|||
| |
|||
≪ |
|||
'''IF''' DUP TYPE 1 == '''THEN''' |
|||
'''IF''' DUP IM NOT '''THEN''' RE '''END END''' |
|||
≫ '<span style="color:blue">REALZ</span>' STO |
|||
. |
|||
≪ → a b c |
|||
≪ '''IF''' b NOT '''THEN''' c a / NEG √ DUP NEG '''ELSE''' |
|||
a c * √ b / |
|||
1 SWAP SQ 4 * - √ 2 / 0.5 + |
|||
b * NEG |
|||
DUP a / <span style="color:blue">REALZ</span> |
|||
c ROT / <span style="color:blue">REALZ</span> '''END''' |
|||
≫ ≫ '<span style="color:blue">QROOT</span>' STO |
|||
| |
|||
<span style="color:blue">REALZ</span> ''( number → number )'' |
|||
if number is a complex |
|||
with no imaginary part, then turn it into a real |
|||
<span style="color:blue">QROOT</span> ''( a b c → r1 r2 ) '' |
|||
if b=0 then roots are obvious, else |
|||
q = sqrt(a*c)/b |
|||
f = 1/2+sqrt(1-4*q^2)/2 |
|||
get -b*f |
|||
root1 = -b/a*f |
|||
root2 = -c/(b*f) |
|||
|} |
|||
1 -1E9 1 <span style="color:blue">QROOT</span> |
|||
actually returns a more correct answer: |
|||
2: 1000000000 |
|||
1: .000000001 |
|||
=={{header|Ruby}}== |
=={{header|Ruby}}== |
||
{{works with|Ruby|1.9.3+}} |
|||
{{trans|Python}} |
|||
The CMath#sqrt method will return a Complex instance if necessary. |
|||
<syntaxhighlight lang="ruby">require 'cmath' |
|||
def quadratic(a, b, c) |
|||
<syntaxhighlight lang="ruby">def sign(x) |
|||
sqrt_discriminant = CMath.sqrt(b**2 - 4*a*c) |
|||
x <=> 0 |
|||
[(-b + sqrt_discriminant) / (2.0*a), (-b - sqrt_discriminant) / (2.0*a)] |
|||
end |
|||
def find_roots(f, range, step=0.001) |
|||
sign = sign(f[range.begin]) |
|||
range.step(step) do |x| |
|||
value = f[x] |
|||
if value == 0 |
|||
puts "Root found at #{x}" |
|||
elsif sign(value) == -sign |
|||
puts "Root found between #{x-step} and #{x}" |
|||
end |
|||
sign = sign(value) |
|||
end |
|||
end |
end |
||
p quadratic(3, 4, 4/3.0) # [-2/3] |
|||
f = lambda { |x| x**3 - 3*x**2 + 2*x } |
|||
p quadratic(3, 2, -1) # [1/3, -1] |
|||
find_roots(f, -1..3)</syntaxhighlight> |
|||
p quadratic(3, 2, 1) # [(-1/3 + sqrt(2/9)i), (-1/3 - sqrt(2/9)i)] |
|||
p quadratic(1, 0, 1) # [(0+i), (0-i)] |
|||
p quadratic(1, -1e6, 1) # [1e6, 1e-6] |
|||
p quadratic(-2, 7, 15) # [-3/2, 5] |
|||
p quadratic(1, -2, 1) # [1] |
|||
p quadratic(1, 3, 3) # [(-3 + sqrt(3)i)/2), (-3 - sqrt(3)i)/2)]</syntaxhighlight> |
|||
{{out}} |
{{out}} |
||
<pre> |
<pre> |
||
[-0.6666666666666666, -0.6666666666666666] |
|||
Root found at 0.0 |
|||
[0.3333333333333333, -1.0] |
|||
Root found at 1.0 |
|||
[(-0.3333333333333333+0.47140452079103173i), (-0.3333333333333333-0.47140452079103173i)] |
|||
Root found at 2.0 |
|||
[(0.0+1.0i), (0.0-1.0i)] |
|||
[999999.999999, 1.00000761449337e-06] |
|||
[-1.5, 5.0] |
|||
[1.0, 1.0] |
|||
[(-1.5+0.8660254037844386i), (-1.5-0.8660254037844386i)] |
|||
</pre> |
</pre> |
||
=={{header|Run BASIC}}== |
|||
Or we could use Enumerable#inject, monkey patching and block: |
|||
<syntaxhighlight lang="runbasic">print "FOR 1,2,3 => ";quad$(1,2,3) |
|||
print "FOR 4,5,6 => ";quad$(4,5,6) |
|||
FUNCTION quad$(a,b,c) |
|||
<syntaxhighlight lang="ruby">class Numeric |
|||
d = b^2-4 * a*c |
|||
def sign |
|||
x = -1*b |
|||
if d<0 then |
|||
end |
|||
quad$ = str$(x/(2*a));" +i";str$(sqr(abs(d))/(2*a))+" , "+str$(x/(2*a));" -i";str$(sqr(abs(d))/abs(2*a)) |
|||
end |
|||
else |
|||
quad$ = str$(x/(2*a)+sqr(d)/(2*a))+" , "+str$(x/(2*a)-sqr(d)/(2*a)) |
|||
end if |
|||
END FUNCTION</syntaxhighlight><pre>FOR 1,2,3 => -1 +i1.41421356 , -1 -i1.41421356 |
|||
FOR 4,5,6 => -0.625 +i1.05326872 , -0.625 -i1.05326872</pre> |
|||
=={{header|Scala}}== |
|||
def find_roots(range, step = 1e-3) |
|||
Using [[Arithmetic/Complex#Scala|Complex]] class from task Arithmetic/Complex. |
|||
range.step( step ).inject( yield(range.begin).sign ) do |sign, x| |
|||
<syntaxhighlight lang="scala">import ArithmeticComplex._ |
|||
value = yield(x) |
|||
object QuadraticRoots { |
|||
if value == 0 |
|||
def solve(a:Double, b:Double, c:Double)={ |
|||
puts "Root found at #{x}" |
|||
val d = b*b-4.0*a*c |
|||
val aa = a+a |
|||
puts "Root found between #{x-step} and #{x}" |
|||
end |
|||
if (d < 0.0) { // complex roots |
|||
value.sign |
|||
val re= -b/aa; |
|||
end |
|||
val im = math.sqrt(-d)/aa; |
|||
end |
|||
(Complex(re, im), Complex(re, -im)) |
|||
} |
|||
else { // real roots |
|||
val re=if (b < 0.0) (-b+math.sqrt(d))/aa else (-b -math.sqrt(d))/aa |
|||
(re, (c/(a*re))) |
|||
} |
|||
} |
|||
}</syntaxhighlight> |
|||
Usage: |
|||
<syntaxhighlight lang="scala">val equations=Array( |
|||
(1.0, 22.0, -1323.0), // two distinct real roots |
|||
(6.0, -23.0, 20.0), // with a != 1.0 |
|||
(1.0, -1.0e9, 1.0), // with one root near zero |
|||
(1.0, 2.0, 1.0), // one real root (double root) |
|||
(1.0, 0.0, 1.0), // two imaginary roots |
|||
(1.0, 1.0, 1.0) // two complex roots |
|||
); |
|||
equations.foreach{v => |
|||
val (a,b,c)=v |
|||
println("a=%g b=%g c=%g".format(a,b,c)) |
|||
val roots=solve(a, b, c) |
|||
println("x1="+roots._1) |
|||
if(roots._1 != roots._2) println("x2="+roots._2) |
|||
println |
|||
}</syntaxhighlight> |
|||
{{out}} |
|||
<pre>a=1.00000 b=22.0000 c=-1323.00 |
|||
x1=-49.0 |
|||
x2=27.0 |
|||
a=6.00000 b=-23.0000 c=20.0000 |
|||
find_roots(-1..3) { |x| x**3 - 3*x**2 + 2*x }</syntaxhighlight> |
|||
x1=2.5 |
|||
x2=1.3333333333333333 |
|||
a=1.00000 b=-1.00000e+09 c=1.00000 |
|||
=={{header|Rust}}== |
|||
x1=1.0E9 |
|||
<syntaxhighlight lang="rust">// 202100315 Rust programming solution |
|||
x2=1.0E-9 |
|||
a=1.00000 b=2.00000 c=1.00000 |
|||
use roots::find_roots_cubic; |
|||
x1=-1.0 |
|||
a=1.00000 b=0.00000 c=1.00000 |
|||
fn main() { |
|||
x1=-0.0 + 1.0i |
|||
x2=-0.0 + -1.0i |
|||
a=1.00000 b=1.00000 c=1.00000 |
|||
let roots = find_roots_cubic(1f32, -3f32, 2f32, 0f32); |
|||
x1=-0.5 + 0.8660254037844386i |
|||
x2=-0.5 + -0.8660254037844386i</pre> |
|||
=={{header|Scheme}}== |
|||
println!("Result : {:?}", roots); |
|||
<syntaxhighlight lang="scheme">(define (quadratic a b c) |
|||
(if (= a 0) |
|||
{{out}} |
|||
(if (= b 0) 'fail (- (/ c b))) |
|||
<pre> |
|||
(let ((delta (- (* b b) (* 4 a c)))) |
|||
Result : Three([0.000000059604645, 0.99999994, 2.0]) |
|||
(if (and (real? delta) (> delta 0)) |
|||
</pre> |
|||
(let ((u (+ b (* (if (>= b 0) 1 -1) (sqrt delta))))) |
|||
(list (/ u -2 a) (/ (* -2 c) u))) |
|||
(list |
|||
(/ (- (sqrt delta) b) 2 a) |
|||
(/ (+ (sqrt delta) b) -2 a)))))) |
|||
Another without external crates: |
|||
<syntaxhighlight lang="rust"> |
|||
use num::Float; |
|||
; examples |
|||
/// Note: We cannot use `range_step` here because Floats don't implement |
|||
/// the `CheckedAdd` trait. |
|||
fn find_roots<T, F>(f: F, start: T, stop: T, step: T, epsilon: T) -> Vec<T> |
|||
where |
|||
T: Copy + PartialOrd + Float, |
|||
F: Fn(T) -> T, |
|||
{ |
|||
let mut ret = vec![]; |
|||
let mut current = start; |
|||
while current < stop { |
|||
if f(current).abs() < epsilon { |
|||
ret.push(current); |
|||
} |
|||
current = current + step; |
|||
} |
|||
ret |
|||
} |
|||
(quadratic 1 -1 -1) |
|||
fn main() { |
|||
; (1.618033988749895 -0.6180339887498948) |
|||
let roots = find_roots( |
|||
|x: f64| x * x * x - 3.0 * x * x + 2.0 * x, |
|||
-1.0, |
|||
3.0, |
|||
0.0001, |
|||
0.00000001, |
|||
); |
|||
(quadratic 1 0 -2) |
|||
println!("roots of f(x) = x^3 - 3x^2 + 2x are: {:?}", roots); |
|||
; (-1.4142135623730951 1.414213562373095) |
|||
} |
|||
(quadratic 1 0 2) |
|||
</syntaxhighlight> |
|||
; (0+1.4142135623730951i 0-1.4142135623730951i) |
|||
{{out}} |
|||
<pre> |
|||
roots of f(x) = x^3 - 3x^2 + 2x are: [-0.00000000000009381755897326649, 0.9999999999998124, 1.9999999999997022] |
|||
</pre> |
|||
(quadratic 1+1i 2 5) |
|||
=={{header|Scala}}== |
|||
; (-1.0922677260818898-1.1884256155834088i 0.09226772608188982+2.1884256155834088i) |
|||
===Imperative version (Ugly, side effects)=== |
|||
{{trans|Java}} |
|||
{{Out}}Best seen running in your browser either by [https://scalafiddle.io/sf/T63KUsH/0 (ES aka JavaScript, non JVM)] or [https://scastie.scala-lang.org/bh8von94Q1y0tInvEZ3cBQ Scastie (remote JVM)]. |
|||
<syntaxhighlight lang="scala">object Roots extends App { |
|||
val poly = (x: Double) => x * x * x - 3 * x * x + 2 * x |
|||
(quadratic 0 4 3) |
|||
private def printRoots(f: Double => Double, |
|||
; -3/4 |
|||
lowerBound: Double, |
|||
upperBound: Double, |
|||
step: Double): Unit = { |
|||
val y = f(lowerBound) |
|||
var (ox, oy, os) = (lowerBound, y, math.signum(y)) |
|||
(quadratic 0 0 1) |
|||
for (x <- lowerBound to upperBound by step) { |
|||
; fail |
|||
val y = f(x) |
|||
val s = math.signum(y) |
|||
if (s == 0) println(x) |
|||
else if (s != os) println(s"~${x - (x - ox) * (y / (y - oy))}") |
|||
(quadratic 1 2 0) |
|||
ox = x |
|||
; (-2 0) |
|||
oy = y |
|||
os = s |
|||
} |
|||
} |
|||
(quadratic 1 2 1) |
|||
printRoots(poly, -1.0, 4, 0.002) |
|||
; (-1 -1) |
|||
(quadratic 1 -1e5 1) |
|||
}</syntaxhighlight> |
|||
; (99999.99999 1.0000000001000001e-05)</syntaxhighlight> |
|||
===Functional version (Recommended)=== |
|||
<syntaxhighlight lang="scala">object RootsOfAFunction extends App { |
|||
def findRoots(fn: Double => Double, start: Double, stop: Double, step: Double, epsilon: Double) = { |
|||
for { |
|||
x <- start to stop by step |
|||
if fn(x).abs < epsilon |
|||
} yield x |
|||
} |
|||
=={{header|Seed7}}== |
|||
def fn(x: Double) = x * x * x - 3 * x * x + 2 * x |
|||
{{trans|Ada}} |
|||
<syntaxhighlight lang="seed7">$ include "seed7_05.s7i"; |
|||
include "float.s7i"; |
|||
include "math.s7i"; |
|||
const type: roots is new struct |
|||
var float: x1 is 0.0; |
|||
var float: x2 is 0.0; |
|||
end struct; |
|||
const func roots: solve (in float: a, in float: b, in float: c) is func |
|||
result |
|||
var roots: solution is roots.value; |
|||
local |
|||
var float: sd is 0.0; |
|||
var float: x is 0.0; |
|||
begin |
|||
sd := sqrt(b**2 - 4.0 * a * c); |
|||
if b < 0.0 then |
|||
x := (-b + sd) / 2.0 * a; |
|||
solution.x1 := x; |
|||
solution.x2 := c / (a * x); |
|||
else |
|||
x := (-b - sd) / 2.0 * a; |
|||
solution.x1 := c / (a * x); |
|||
solution.x2 := x; |
|||
end if; |
|||
end func; |
|||
const proc: main is func |
|||
local |
|||
var roots: r is roots.value; |
|||
begin |
|||
r := solve(1.0, -10.0E5, 1.0); |
|||
writeln("X1 = " <& r.x1 digits 6 <& " X2 = " <& r.x2 digits 6); |
|||
end func;</syntaxhighlight> |
|||
println(findRoots(fn, -1.0, 3.0, 0.0001, 0.000000001)) |
|||
}</syntaxhighlight> |
|||
{{out}} |
{{out}} |
||
<pre> |
|||
Vector(-9.381755897326649E-14, 0.9999999999998124, 1.9999999999997022) |
|||
X1 = 1000000.000000 X2 = 0.000001 |
|||
</pre> |
|||
=={{header|Sidef}}== |
=={{header|Sidef}}== |
||
<syntaxhighlight lang="ruby"> |
<syntaxhighlight lang="ruby">var sets = [ |
||
[1, 2, 1], |
|||
[1, 2, 3], |
|||
[1, -2, 1], |
|||
[1, 0, -4], |
|||
[1, -1e6, 1], |
|||
] |
|||
func quadroots(a, b, c) { |
|||
var root = sqrt(b**2 - 4*a*c) |
|||
[(-b + root) / (2 * a), |
|||
(-b - root) / (2 * a)] |
|||
} |
} |
||
sets.each { |coefficients| |
|||
var step = 0.001 |
|||
say ("Roots for #{coefficients}", |
|||
var start = -1 |
|||
"=> (#{quadroots(coefficients...).join(', ')})") |
|||
var stop = 3 |
|||
for x in range(start+step, stop, step) { |
|||
static sign = false |
|||
given (var value = f(x)) { |
|||
when (0) { |
|||
say "Root found at #{x}" |
|||
} |
|||
case (sign && ((value > 0) != sign)) { |
|||
say "Root found near #{x}" |
|||
} |
|||
} |
|||
sign = value>0 |
|||
}</syntaxhighlight> |
}</syntaxhighlight> |
||
{{out}} |
{{out}} |
||
<pre> |
<pre> |
||
Roots for [1, 2, 1]=> (-1, -1) |
|||
Root found at 1 |
|||
Roots for [1, 2, 3]=> (-1+1.41421356237309504880168872420969807856967187538i, -1-1.41421356237309504880168872420969807856967187538i) |
|||
Root found at 2</pre> |
|||
Roots for [1, -2, 1]=> (1, 1) |
|||
Roots for [1, 0, -4]=> (2, -2) |
|||
Roots for [1, -1000000, 1]=> (999999.999998999999999998999999999997999999999995, 0.00000100000000000100000000000200000000000500000000002) |
|||
</pre> |
|||
=={{header|Stata}}== |
|||
<syntaxhighlight lang="stata">mata |
|||
: polyroots((-2,0,1)) |
|||
1 2 |
|||
+-----------------------------+ |
|||
1 | 1.41421356 -1.41421356 | |
|||
+-----------------------------+ |
|||
: polyroots((2,0,1)) |
|||
1 2 |
|||
+-------------------------------+ |
|||
1 | -1.41421356i 1.41421356i | |
|||
+-------------------------------+</syntaxhighlight> |
|||
=={{header|Tcl}}== |
=={{header|Tcl}}== |
||
{{tcllib|math::complexnumbers}} |
|||
This simple brute force iteration marks all results, with a leading "~", as approximate. This version always reports its results as approximate because of the general limits of computation using fixed-width floating-point numbers (i.e., IEEE double-precision floats). |
|||
<syntaxhighlight lang="tcl"> |
<syntaxhighlight lang="tcl">package require math::complexnumbers |
||
namespace import math::complexnumbers::complex math::complexnumbers::tostring |
|||
set res {} |
|||
set lastsign [sgn [apply $lambda $start]] |
|||
proc quadratic {a b c} { |
|||
for {set x $start} {$x <= $end} {set x [expr {$x + $step}]} { |
|||
set discrim [expr {$b**2 - 4*$a*$c}] |
|||
set roots [list] |
|||
if {$sign != $lastsign} { |
|||
if {$discrim < 0} { |
|||
lappend res [format ~%.11f $x] |
|||
} |
set term1 [expr {(-1.0*$b)/(2*$a)}] |
||
set |
set term2 [expr {sqrt(abs($discrim))/(2*$a)}] |
||
lappend roots [tostring [complex $term1 $term2]] \ |
|||
[tostring [complex $term1 [expr {-1 * $term2}]]] |
|||
} elseif {$discrim == 0} { |
|||
lappend roots [expr {-1.0*$b / (2*$a)}] |
|||
} else { |
|||
lappend roots [expr {(-1*$b + sqrt($discrim)) / (2 * $a)}] \ |
|||
[expr {(-1*$b - sqrt($discrim)) / (2 * $a)}] |
|||
} |
} |
||
return $ |
return $roots |
||
} |
} |
||
proc sgn x {expr {($x>0) - ($x<0)}} |
|||
proc report_quad {a b c} { |
|||
puts [froots {x {expr {$x**3 - 3*$x**2 + 2*$x}}}]</syntaxhighlight> |
|||
puts [format "%sx**2 + %sx + %s = 0" $a $b $c] |
|||
Result and timing: |
|||
foreach root [quadratic $a $b $c] { |
|||
<pre>/Tcl $ time ./froots.tcl |
|||
puts " x = $root" |
|||
~0.00000000000 ~1.00000000000 ~2.00000000000 |
|||
real 0m0.368s |
|||
user 0m0.062s |
|||
sys 0m0.030s</pre> |
|||
A more elegant solution (and faster, because you can usually make the initial search coarser) is to use brute-force iteration and then refine with [[wp:Newton's method|Newton-Raphson]], but that requires the differential of the function with respect to the search variable. |
|||
<syntaxhighlight lang="tcl">proc frootsNR {f df {start -3} {end 3} {step 0.001}} { |
|||
set res {} |
|||
set lastsign [sgn [apply $f $start]] |
|||
for {set x $start} {$x <= $end} {set x [expr {$x + $step}]} { |
|||
set sign [sgn [apply $f $x]] |
|||
if {$sign != $lastsign} { |
|||
lappend res [format ~%.15f [nr $x $f $df]] |
|||
} |
|||
set lastsign $sign |
|||
} |
} |
||
return $res |
|||
} |
|||
proc sgn x {expr {($x>0) - ($x<0)}} |
|||
proc nr {x1 f df} { |
|||
# Newton's method converges very rapidly indeed |
|||
for {set iters 0} {$iters < 10} {incr iters} { |
|||
set x1 [expr { |
|||
[set x0 $x1] - [apply $f $x0]/[apply $df $x0] |
|||
}] |
|||
if {$x0 == $x1} { |
|||
break |
|||
} |
|||
} |
|||
return $x1 |
|||
} |
} |
||
# examples on this page |
|||
puts [frootsNR \ |
|||
report_quad 3 4 [expr {4/3.0}] ;# {-2/3} |
|||
{x {expr {$x**3 - 3*$x**2 + 2*$x}}} \ |
|||
report_quad 3 2 -1 ;# {1/3, -1} |
|||
{x {expr {3*$x**2 - 6*$x + 2}}}]</syntaxhighlight> |
|||
report_quad 3 2 1 ;# {(-1/3 + sqrt(2/9)i), (-1/3 - sqrt(2/9)i)} |
|||
report_quad 1 0 1 ;# {(0+i), (0-i)} |
|||
report_quad 1 -1e6 1 ;# {1e6, 1e-6} |
|||
# examples from http://en.wikipedia.org/wiki/Quadratic_equation |
|||
report_quad -2 7 15 ;# {5, -3/2} |
|||
report_quad 1 -2 1 ;# {1} |
|||
report_quad 1 3 3 ;# {(-3 - sqrt(3)i)/2), (-3 + sqrt(3)i)/2)}</syntaxhighlight> |
|||
{{out}} |
|||
<pre>3x**2 + 4x + 1.3333333333333333 = 0 |
|||
x = -0.6666666666666666 |
|||
3x**2 + 2x + -1 = 0 |
|||
x = 0.3333333333333333 |
|||
x = -1.0 |
|||
3x**2 + 2x + 1 = 0 |
|||
x = -0.3333333333333333+0.47140452079103173i |
|||
x = -0.3333333333333333-0.47140452079103173i |
|||
1x**2 + 0x + 1 = 0 |
|||
x = i |
|||
x = -i |
|||
1x**2 + -1e6x + 1 = 0 |
|||
x = 999999.999999 |
|||
x = 1.00000761449337e-6 |
|||
-2x**2 + 7x + 15 = 0 |
|||
x = -1.5 |
|||
x = 5.0 |
|||
1x**2 + -2x + 1 = 0 |
|||
x = 1.0 |
|||
1x**2 + 3x + 3 = 0 |
|||
x = -1.5+0.8660254037844386i |
|||
x = -1.5-0.8660254037844386i</pre> |
|||
=={{header|TI-89 BASIC}}== |
=={{header|TI-89 BASIC}}== |
||
TI-89 BASIC has built-in numeric and algebraic solvers. |
|||
Finding roots is a built-in function: <code>zeros(x^3-3x^2+2x, x)</code> returns <code>{0,1,2}</code>. |
|||
<syntaxhighlight lang="text">solve(x^2-1E9x+1.0)</syntaxhighlight> |
|||
returns |
|||
In this case, the roots are exact; inexact results are marked by decimal points. |
|||
<pre>x=1.E-9 or x=1.E9</pre> |
|||
=={{header|Wren}}== |
=={{header|Wren}}== |
||
{{trans|Go}} |
{{trans|Go}} |
||
{{libheader|Wren- |
{{libheader|Wren-complex}} |
||
<syntaxhighlight lang=" |
<syntaxhighlight lang="wren">import "./complex" for Complex |
||
var |
var quadratic = Fn.new { |a, b, c| |
||
var |
var d = b*b - 4*a*c |
||
if (d == 0) { |
|||
// single root |
|||
return [[-b/(2*a)], null] |
|||
f1 = f.call(x1) |
|||
if (f1 == 0) return [x1, "exact"] |
|||
if ((x1-x0).abs < 1e-6) return [x1, "approximate"] |
|||
var t = x0 |
|||
x0 = x1 |
|||
x1 = x1-f1*(x1-t)/(f1-f0) |
|||
} |
} |
||
if (d > 0) { |
|||
// two real roots |
|||
var sr = d.sqrt |
|||
d = (b < 0) ? sr - b : -sr - b |
|||
return [[d/(2*a), 2*c/d], null] |
|||
} |
|||
// two complex roots |
|||
var den = 1 / (2*a) |
|||
var t1 = Complex.new(-b*den, 0) |
|||
var t2 = Complex.new(0, (-d).sqrt * den) |
|||
return [[], [t1+t2, t1-t2]] |
|||
} |
} |
||
var |
var test = Fn.new { |a, b, c| |
||
System.write("coefficients: %(a), %(b), %(c) -> ") |
|||
var x0 = lower |
|||
var |
var roots = quadratic.call(a, b, c) |
||
var r = roots[0] |
|||
if (r.count == 1) { |
|||
System.print("one real root: %(r[0])") |
|||
} else if (r.count == 2) { |
|||
System.print("two real roots: %(r[0]) and %(r[1])") |
|||
} else { |
|||
if (status != "" && r >= x0 && r < x1) { |
|||
var i = roots[1] |
|||
System.print("two complex roots: %(i[0]) and %(i[1])") |
|||
} |
|||
x0 = x1 |
|||
x1 = x1 + step |
|||
} |
} |
||
} |
} |
||
var coeffs = [ |
|||
var example = Fn.new { |x| x*x*x - 3*x*x + 2*x } |
|||
[1, -2, 1], |
|||
findRoots.call(example, -0.5, 2.6, 1)</syntaxhighlight> |
|||
[1, 0, 1], |
|||
[1, -10, 1], |
|||
[1, -1000, 1], |
|||
[1, -1e9, 1] |
|||
] |
|||
for (c in coeffs) test.call(c[0], c[1], c[2])</syntaxhighlight> |
|||
{{out}} |
{{out}} |
||
<pre> |
<pre> |
||
coefficients: 1, -2, 1 -> one real root: 1 |
|||
0.000 approximate |
|||
coefficients: 1, 0, 1 -> two complex roots: 0 + i and 0 - i |
|||
1.000 exact |
|||
coefficients: 1, -10, 1 -> two real roots: 9.8989794855664 and 0.10102051443364 |
|||
2.000 approximate |
|||
coefficients: 1, -1000, 1 -> two real roots: 999.998999999 and 0.001000001000002 |
|||
coefficients: 1, -1000000000, 1 -> two real roots: 1000000000 and 1e-09 |
|||
</pre> |
</pre> |
||
=={{header| |
=={{header|XPL0}}== |
||
{{trans| |
{{trans|Go}} |
||
<syntaxhighlight lang |
<syntaxhighlight lang "XPL0">include xpllib; \for Print |
||
[start..stop,step].filter('wrap(x){ f(x).closeTo(0.0,eps) }) |
|||
func real QuadRoots(A, B, C); \Return roots of quadratic equation |
|||
}</syntaxhighlight> |
|||
real A, B, C; |
|||
<syntaxhighlight lang="zkl">fcn f(x){ x*x*x - 3.0*x*x + 2.0*x } |
|||
real D, E, R; |
|||
findRoots(f, -1.0, 3.0, 0.0001, 0.00000001).println();</syntaxhighlight> |
|||
[R:= [0., 0., 0.]; |
|||
R(0):= 0.; R(1):= 0.; R(2):= 0.; |
|||
D:= B*B - 4.*A*C; |
|||
case of |
|||
D = 0.: [R(0):= -B / (2.*A); \single root |
|||
R(1):= R(0); |
|||
]; |
|||
D > 0.: [if B < 0. then \two real roots |
|||
E:= sqrt(D) - B |
|||
else E:= -sqrt(D) - B; |
|||
R(0):= E / (2.*A); |
|||
R(1):= 2. * C / E; |
|||
]; |
|||
D < 0.: [R(0):= -B / (2.*A); \real |
|||
R(2):= sqrt(-D) /(2.*A); \imaginary |
|||
] |
|||
other []; \D overflowed or a coefficient was NaN |
|||
return R; |
|||
]; |
|||
func Test(A, B, C); |
|||
real A, B, C; |
|||
real R; |
|||
[Print("coefficients: %g, %g, %g -> ", A, B, C); |
|||
R:= QuadRoots(A, B, C); |
|||
if R(2) # 0. then |
|||
Print("two complex roots: %g+%gi, %g-%gi\n", R(0), R(2), R(0), R(2)) |
|||
else [if R(0) = R(1) then |
|||
Print("one real root: %g\n", R(0)) |
|||
else Print("two real roots: %15.15g, %15.15g\n", R(0), R(1)); |
|||
]; |
|||
]; |
|||
real C; int I; |
|||
[C:= [ [1., -2., 1.], |
|||
[1., 0., 1.], |
|||
[1., -10., 1.], |
|||
[1., -1000., 1.], |
|||
[1., -1e9, 1.], |
|||
[1., -4., 6.] ]; |
|||
for I:= 0 to 5 do |
|||
Test(C(I,0), C(I,1), C(I,2)); |
|||
]</syntaxhighlight> |
|||
{{out}} |
{{out}} |
||
<pre> |
|||
<pre>L(-9.38176e-14,1,2)</pre> |
|||
coefficients: 1, -2, 1 -> one real root: 1 |
|||
{{trans|C}} |
|||
coefficients: 1, 0, 1 -> two complex roots: 0+1i, 0-1i |
|||
<syntaxhighlight lang="zkl">fcn secant(f,xA,xB){ |
|||
coefficients: 1, -10, 1 -> two real roots: 9.89897948556636, 0.101020514433644 |
|||
reg e=1.0e-12; |
|||
coefficients: 1, -1000, 1 -> two real roots: 999.998999999, 0.001000001000002 |
|||
coefficients: 1, -1e9, 1 -> two real roots: 1000000000, 0.000000001 |
|||
coefficients: 1, -4, 6 -> two complex roots: 2+1.41421i, 2-1.41421i |
|||
</pre> |
|||
=={{header|zkl}}== |
|||
fA:=f(xA); if(fA.closeTo(0.0,e)) return(xA); |
|||
zkl doesn't have a complex number package. |
|||
{{trans|Elixir}} |
|||
do(50){ |
|||
<syntaxhighlight lang="zkl">fcn quadratic(a,b,c){ b=b.toFloat(); |
|||
fB:=f(xB); |
|||
println("Roots of a quadratic function %s, %s, %s".fmt(a,b,c)); |
|||
d:=(xB - xA) / (fB - fA) * fB; |
|||
d,a2:=(b*b - 4*a*c), a+a; |
|||
if(d.closeTo(0,e)) break; |
|||
if(d>0){ |
|||
xA = xB; fA = fB; xB -= d; |
|||
sd:=d.sqrt(); |
|||
println(" the real roots are %s and %s".fmt((-b + sd)/a2,(-b - sd)/a2)); |
|||
} |
|||
else if(d==0) println(" the single root is ",-b/a2); |
|||
else{ |
|||
sd:=(-d).sqrt(); |
|||
println(" the complex roots are %s and \U00B1;%si".fmt(-b/a2,sd/a2)); |
|||
} |
} |
||
if(f(xB).closeTo(0.0,e)) xB |
|||
else "Function is not converging near (%7.4f,%7.4f).".fmt(xA,xB); |
|||
}</syntaxhighlight> |
}</syntaxhighlight> |
||
<syntaxhighlight lang="zkl"> |
<syntaxhighlight lang="zkl">foreach a,b,c in (T( T(1,-2,1), T(1,-3,2), T(1,0,1), T(1,-1.0e10,1), T(1,2,3), T(2,-1,-6)) ){ |
||
quadratic(a,b,c) |
|||
xs:=findRoots(f, -1.032, 3.0, step, 0.1); |
|||
}</syntaxhighlight> |
|||
{{out}} |
{{out}} |
||
<pre> |
|||
<pre>L(-0.032,0.968,1.068,1.968) --> L(1.87115e-19,1,1,2)</pre> |
|||
Roots of a quadratic function 1, -2, 1 |
|||
the single root is 1 |
|||
Roots of a quadratic function 1, -3, 2 |
|||
the real roots are 2 and 1 |
|||
Roots of a quadratic function 1, 0, 1 |
|||
the complex roots are 0 and ±1i |
|||
Roots of a quadratic function 1, -1e+10, 1 |
|||
the real roots are 1e+10 and 0 |
|||
Roots of a quadratic function 1, 2, 3 |
|||
the complex roots are -1 and ±1.41421i |
|||
Roots of a quadratic function 2, -1, -6 |
|||
the real roots are 2 and -1.5 |
|||
</pre> |
|||
{{omit from|M4}} |
{{omit from|M4}} |
Latest revision as of 10:05, 3 February 2024
You are encouraged to solve this task according to the task description, using any language you may know.
Write a program to find the roots of a quadratic equation, i.e., solve the equation . Your program must correctly handle non-real roots, but it need not check that .
The problem of solving a quadratic equation is a good example of how dangerous it can be to ignore the peculiarities of floating-point arithmetic. The obvious way to implement the quadratic formula suffers catastrophic loss of accuracy when one of the roots to be found is much closer to 0 than the other. In their classic textbook on numeric methods Computer Methods for Mathematical Computations, George Forsythe, Michael Malcolm, and Cleve Moler suggest trying the naive algorithm with , , and . (For double-precision floats, set .) Consider the following implementation in Ada:
with Ada.Text_IO; use Ada.Text_IO;
with Ada.Numerics.Elementary_Functions; use Ada.Numerics.Elementary_Functions;
procedure Quadratic_Equation is
type Roots is array (1..2) of Float;
function Solve (A, B, C : Float) return Roots is
SD : constant Float := sqrt (B**2 - 4.0 * A * C);
AA : constant Float := 2.0 * A;
begin
return ((- B + SD) / AA, (- B - SD) / AA);
end Solve;
R : constant Roots := Solve (1.0, -10.0E5, 1.0);
begin
Put_Line ("X1 =" & Float'Image (R (1)) & " X2 =" & Float'Image (R (2)));
end Quadratic_Equation;
- Output:
X1 = 1.00000E+06 X2 = 0.00000E+00
As we can see, the second root has lost all significant figures. The right answer is that X2
is about . The naive method is numerically unstable.
Suggested by Middlebrook (D-OA), a better numerical method: to define two parameters and
and the two roots of the quardratic are: and
Task: do it better. This means that given , , and , both of the roots your program returns should be greater than . Or, if your language can't do floating-point arithmetic any more precisely than single precision, your program should be able to handle . Either way, show what your program gives as the roots of the quadratic in question. See page 9 of
"What Every Scientist Should Know About Floating-Point Arithmetic" for a possible algorithm.
11l
F quad_roots(a, b, c)
V sqd = Complex(b^2 - 4*a*c) ^ 0.5
R ((-b + sqd) / (2 * a),
(-b - sqd) / (2 * a))
V testcases = [(3.0, 4.0, 4 / 3),
(3.0, 2.0, -1.0),
(3.0, 2.0, 1.0),
(1.0, -1e9, 1.0),
(1.0, -1e100, 1.0)]
L(a, b, c) testcases
V (r1, r2) = quad_roots(a, b, c)
print(r1, end' ‘ ’)
print(r2)
- Output:
-0.666667+0i -0.666667+0i 0.333333+0i -1+0i -0.333333+0.471405i -0.333333-0.471405i 1e+09+0i 0i 1e+100+0i 0i
Ada
with Ada.Text_IO; use Ada.Text_IO;
with Ada.Numerics.Elementary_Functions; use Ada.Numerics.Elementary_Functions;
procedure Quadratic_Equation is
type Roots is array (1..2) of Float;
function Solve (A, B, C : Float) return Roots is
SD : constant Float := sqrt (B**2 - 4.0 * A * C);
X : Float;
begin
if B < 0.0 then
X := (- B + SD) / (2.0 * A);
return (X, C / (A * X));
else
X := (- B - SD) / (2.0 * A);
return (C / (A * X), X);
end if;
end Solve;
R : constant Roots := Solve (1.0, -10.0E5, 1.0);
begin
Put_Line ("X1 =" & Float'Image (R (1)) & " X2 =" & Float'Image (R (2)));
end Quadratic_Equation;
Here precision loss is prevented by checking signs of operands. On errors, Constraint_Error is propagated on numeric errors and when roots are complex.
- Output:
X1 = 1.00000E+06 X2 = 1.00000E-06
ALGOL 68
quadratic equation:
BEGIN
MODE ROOTS = UNION([]REAL, []COMPL);
MODE QUADRATIC = STRUCT(REAL a,b,c);
PROC solve = (QUADRATIC q)ROOTS:
BEGIN
REAL a = a OF q, b = b OF q, c = c OF q;
REAL sa = b**2 - 4*a*c;
IF sa >=0 THEN # handle the +ve case as REAL #
REAL sqrt sa = ( b<0 | sqrt(sa) | -sqrt(sa));
REAL r1 = (-b + sqrt sa)/(2*a),
r2 = (-b - sqrt sa)/(2*a);
[]REAL((r1,r2))
ELSE # handle the -ve case as COMPL conjugate pairs #
COMPL compl sqrt sa = ( b<0 | complex sqrt(sa) | -complex sqrt(sa));
COMPL r1 = (-b + compl sqrt sa)/(2*a),
r2 = (-b - compl sqrt sa)/(2*a);
[]COMPL (r1, r2)
FI
END # solve #;
PROC real evaluate = (QUADRATIC q, REAL x )REAL: (a OF q*x + b OF q)*x + c OF q;
PROC compl evaluate = (QUADRATIC q, COMPL x)COMPL: (a OF q*x + b OF q)*x + c OF q;
# only a very tiny difference between the 2 examples #
[]QUADRATIC test = ((1, -10e5, 1), (1, 0, 1), (1,-3,2), (1,3,2), (4,0,4), (3,4,5));
FORMAT real fmt = $g(-0,8)$;
FORMAT compl fmt = $f(real fmt)"+"f(real fmt)"i"$;
FORMAT quadratic fmt = $f(real fmt)" x**2 + "f(real fmt)" x + "f(real fmt)" = 0"$;
FOR index TO UPB test DO
QUADRATIC quadratic = test[index];
ROOTS r = solve(quadratic);
# Output the two different scenerios #
printf(($"Quadratic: "$, quadratic fmt, quadratic, $l$));
CASE r IN
([]REAL r):
printf(($"REAL x1 = "$, real fmt, r[1],
$", x2 = "$, real fmt, r[2], $"; "$,
$"REAL y1 = "$, real fmt, real evaluate(quadratic,r[1]),
$", y2 = "$, real fmt, real evaluate(quadratic,r[2]), $";"ll$
)),
([]COMPL c):
printf(($"COMPL x1,x2 = "$, real fmt, re OF c[1], $"+/-"$,
real fmt, ABS im OF c[1], $"; "$,
$"COMPL y1 = "$, compl fmt, compl evaluate(quadratic,c[1]),
$", y2 = "$, compl fmt, compl evaluate(quadratic,c[2]), $";"ll$
))
ESAC
OD
END # quadratic_equation #
- Output:
Quadratic: 1.00000000 x**2 + -1000000.00000000 x + 1.00000000 = 0 REAL x1 = 999999.99999900, x2 = .00000100; REAL y1 = -.00000761, y2 = -.00000761; Quadratic: 1.00000000 x**2 + .00000000 x + 1.00000000 = 0 COMPL x1,x2 = .00000000+/-1.00000000; COMPL y1 = .00000000+.00000000i, y2 = .00000000+.00000000i; Quadratic: 1.00000000 x**2 + -3.00000000 x + 2.00000000 = 0 REAL x1 = 2.00000000, x2 = 1.00000000; REAL y1 = .00000000, y2 = .00000000; Quadratic: 1.00000000 x**2 + 3.00000000 x + 2.00000000 = 0 REAL x1 = -2.00000000, x2 = -1.00000000; REAL y1 = .00000000, y2 = .00000000; Quadratic: 4.00000000 x**2 + .00000000 x + 4.00000000 = 0 COMPL x1,x2 = .00000000+/-1.00000000; COMPL y1 = .00000000+.00000000i, y2 = .00000000+.00000000i; Quadratic: 3.00000000 x**2 + 4.00000000 x + 5.00000000 = 0 COMPL x1,x2 = -.66666667+/-1.10554160; COMPL y1 = .00000000+.00000000i, y2 = .00000000+-.00000000i;
AutoHotkey
ahk forum: discussion
MsgBox % quadratic(u,v, 1,-3,2) ", " u ", " v
MsgBox % quadratic(u,v, 1,3,2) ", " u ", " v
MsgBox % quadratic(u,v, -2,4,-2) ", " u ", " v
MsgBox % quadratic(u,v, 1,0,1) ", " u ", " v
SetFormat FloatFast, 0.15e
MsgBox % quadratic(u,v, 1,-1.0e8,1) ", " u ", " v
quadratic(ByRef x1, ByRef x2, a,b,c) { ; -> #real roots {x1,x2} of ax²+bx+c
If (a = 0)
Return -1 ; ERROR: not quadratic
d := b*b - 4*a*c
If (d < 0) {
x1 := x2 := ""
Return 0
}
If (d = 0) {
x1 := x2 := -b/2/a
Return 1
}
x1 := (-b - (b<0 ? -sqrt(d) : sqrt(d)))/2/a
x2 := c/a/x1
Return 2
}
BBC BASIC
FOR test% = 1 TO 7
READ a$, b$, c$
PRINT "For a = " ; a$ ", b = " ; b$ ", c = " ; c$ TAB(32) ;
PROCsolvequadratic(EVAL(a$), EVAL(b$), EVAL(c$))
NEXT
END
DATA 1, -1E9, 1
DATA 1, 0, 1
DATA 2, -1, -6
DATA 1, 2, -2
DATA 0.5, SQR(2), 1
DATA 1, 3, 2
DATA 3, 4, 5
DEF PROCsolvequadratic(a, b, c)
LOCAL d, f
d = b^2 - 4*a*c
CASE SGN(d) OF
WHEN 0:
PRINT "the single root is " ; -b/2/a
WHEN +1:
f = (1 + SQR(1-4*a*c/b^2))/2
PRINT "the real roots are " ; -f*b/a " and " ; -c/b/f
WHEN -1:
PRINT "the complex roots are " ; -b/2/a " +/- " ; SQR(-d)/2/a "*i"
ENDCASE
ENDPROC
- Output:
For a = 1, b = -1E9, c = 1 the real roots are 1E9 and 1E-9 For a = 1, b = 0, c = 1 the complex roots are 0 +/- 1*i For a = 2, b = -1, c = -6 the real roots are 2 and -1.5 For a = 1, b = 2, c = -2 the real roots are -2.73205081 and 0.732050808 For a = 0.5, b = SQR(2), c = 1 the single root is -1.41421356 For a = 1, b = 3, c = 2 the real roots are -2 and -1 For a = 3, b = 4, c = 5 the complex roots are -0.666666667 +/- 1.1055416*i
C
Code that tries to avoid floating point overflow and other unfortunate loss of precissions: (compiled with gcc -std=c99
for complex
, though easily adapted to just real numbers)
#include <stdio.h>
#include <stdlib.h>
#include <complex.h>
#include <math.h>
typedef double complex cplx;
void quad_root
(double a, double b, double c, cplx * ra, cplx *rb)
{
double d, e;
if (!a) {
*ra = b ? -c / b : 0;
*rb = 0;
return;
}
if (!c) {
*ra = 0;
*rb = -b / a;
return;
}
b /= 2;
if (fabs(b) > fabs(c)) {
e = 1 - (a / b) * (c / b);
d = sqrt(fabs(e)) * fabs(b);
} else {
e = (c > 0) ? a : -a;
e = b * (b / fabs(c)) - e;
d = sqrt(fabs(e)) * sqrt(fabs(c));
}
if (e < 0) {
e = fabs(d / a);
d = -b / a;
*ra = d + I * e;
*rb = d - I * e;
return;
}
d = (b >= 0) ? d : -d;
e = (d - b) / a;
d = e ? (c / e) / a : 0;
*ra = d;
*rb = e;
return;
}
int main()
{
cplx ra, rb;
quad_root(1, 1e12 + 1, 1e12, &ra, &rb);
printf("(%g + %g i), (%g + %g i)\n",
creal(ra), cimag(ra), creal(rb), cimag(rb));
quad_root(1e300, -1e307 + 1, 1e300, &ra, &rb);
printf("(%g + %g i), (%g + %g i)\n",
creal(ra), cimag(ra), creal(rb), cimag(rb));
return 0;
}
- Output:
(-1e+12 + 0 i), (-1 + 0 i) (1.00208e+07 + 0 i), (9.9792e-08 + 0 i)
#include <stdio.h>
#include <math.h>
#include <complex.h>
void roots_quadratic_eq(double a, double b, double c, complex double *x)
{
double delta;
delta = b*b - 4.0*a*c;
x[0] = (-b + csqrt(delta)) / (2.0*a);
x[1] = (-b - csqrt(delta)) / (2.0*a);
}
void roots_quadratic_eq2(double a, double b, double c, complex double *x)
{
b /= a;
c /= a;
double delta = b*b - 4*c;
if ( delta < 0 ) {
x[0] = -b/2 + I*sqrt(-delta)/2.0;
x[1] = -b/2 - I*sqrt(-delta)/2.0;
} else {
double root = sqrt(delta);
double sol = (b>0) ? (-b - root)/2.0 : (-b + root)/2.0;
x[0] = sol;
x[1] = c/sol;
}
}
int main()
{
complex double x[2];
roots_quadratic_eq(1, -1e20, 1, x);
printf("x1 = (%.20le, %.20le)\nx2 = (%.20le, %.20le)\n\n",
creal(x[0]), cimag(x[0]),
creal(x[1]), cimag(x[1]));
roots_quadratic_eq2(1, -1e20, 1, x);
printf("x1 = (%.20le, %.20le)\nx2 = (%.20le, %.20le)\n\n",
creal(x[0]), cimag(x[0]),
creal(x[1]), cimag(x[1]));
return 0;
}
x1 = (1.00000000000000000000e+20, 0.00000000000000000000e+00) x2 = (0.00000000000000000000e+00, 0.00000000000000000000e+00) x1 = (1.00000000000000000000e+20, 0.00000000000000000000e+00) x2 = (9.99999999999999945153e-21, 0.00000000000000000000e+00)
C#
using System;
using System.Numerics;
class QuadraticRoots
{
static Tuple<Complex, Complex> Solve(double a, double b, double c)
{
var q = -(b + Math.Sign(b) * Complex.Sqrt(b * b - 4 * a * c)) / 2;
return Tuple.Create(q / a, c / q);
}
static void Main()
{
Console.WriteLine(Solve(1, -1E20, 1));
}
}
- Output:
((1E+20, 0), (1E-20, 0))
C++
#include <iostream>
#include <utility>
#include <complex>
typedef std::complex<double> complex;
std::pair<complex, complex>
solve_quadratic_equation(double a, double b, double c)
{
b /= a;
c /= a;
double discriminant = b*b-4*c;
if (discriminant < 0)
return std::make_pair(complex(-b/2, std::sqrt(-discriminant)/2),
complex(-b/2, -std::sqrt(-discriminant)/2));
double root = std::sqrt(discriminant);
double solution1 = (b > 0)? (-b - root)/2
: (-b + root)/2;
return std::make_pair(solution1, c/solution1);
}
int main()
{
std::pair<complex, complex> result = solve_quadratic_equation(1, -1e20, 1);
std::cout << result.first << ", " << result.second << std::endl;
}
- Output:
(1e+20,0), (1e-20,0)
Clojure
(defn quadratic
"Compute the roots of a quadratic in the form ax^2 + bx + c = 1.
Returns any of nil, a float, or a vector."
[a b c]
(let [sq-d (Math/sqrt (- (* b b) (* 4 a c)))
f #(/ (% b sq-d) (* 2 a))]
(cond
(neg? sq-d) nil
(zero? sq-d) (f +)
(pos? sq-d) [(f +) (f -)]
:else nil))) ; maybe our number ended up as NaN
- Output:
user=> (quadratic 1.0 1.0 1.0)
nil
user=> (quadratic 1.0 2.0 1.0)
1.0
user=> (quadratic 1.0 3.0 1.0)
[2.618033988749895 0.3819660112501051]
Common Lisp
(defun quadratic (a b c)
(list
(/ (+ (- b) (sqrt (- (expt b 2) (* 4 a c)))) (* 2 a))
(/ (- (- b) (sqrt (- (expt b 2) (* 4 a c)))) (* 2 a))))
D
import std.math, std.traits;
CommonType!(T1, T2, T3)[] naiveQR(T1, T2, T3)
(in T1 a, in T2 b, in T3 c)
pure nothrow if (isFloatingPoint!T1) {
alias ReturnT = typeof(typeof(return).init[0]);
if (a == 0)
return [ReturnT(c / b)]; // It's a linear function.
immutable ReturnT det = b ^^ 2 - 4 * a * c;
if (det < 0)
return []; // No real number root.
immutable SD = sqrt(det);
return [(-b + SD) / 2 * a, (-b - SD) / 2 * a];
}
CommonType!(T1, T2, T3)[] cautiQR(T1, T2, T3)
(in T1 a, in T2 b, in T3 c)
pure nothrow if (isFloatingPoint!T1) {
alias ReturnT = typeof(typeof(return).init[0]);
if (a == 0)
return [ReturnT(c / b)]; // It's a linear function.
immutable ReturnT det = b ^^ 2 - 4 * a * c;
if (det < 0)
return []; // No real number root.
immutable SD = sqrt(det);
if (b * a < 0) {
immutable x = (-b + SD) / 2 * a;
return [x, c / (a * x)];
} else {
immutable x = (-b - SD) / 2 * a;
return [c / (a * x), x];
}
}
void main() {
import std.stdio;
writeln("With 32 bit float type:");
writefln(" Naive: [%(%g, %)]", naiveQR(1.0f, -10e5f, 1.0f));
writefln("Cautious: [%(%g, %)]", cautiQR(1.0f, -10e5f, 1.0f));
writeln("\nWith 64 bit double type:");
writefln(" Naive: [%(%g, %)]", naiveQR(1.0, -10e5, 1.0));
writefln("Cautious: [%(%g, %)]", cautiQR(1.0, -10e5, 1.0));
writeln("\nWith real type:");
writefln(" Naive: [%(%g, %)]", naiveQR(1.0L, -10e5L, 1.0L));
writefln("Cautious: [%(%g, %)]", cautiQR(1.0L, -10e5L, 1.0L));
}
- Output:
With 32 bit float type: Naive: [1e+06, 0] Cautious: [1e+06, 1e-06] With 64 bit double type: Naive: [1e+06, 1.00001e-06] Cautious: [1e+06, 1e-06] With real type: Naive: [1e+06, 1e-06] Cautious: [1e+06, 1e-06]
Delphi
See Pascal.
Elixir
defmodule Quadratic do
def roots(a, b, c) do
IO.puts "Roots of a quadratic function (#{a}, #{b}, #{c})"
d = b * b - 4 * a * c
a2 = a * 2
cond do
d > 0 ->
sd = :math.sqrt(d)
IO.puts " the real roots are #{(- b + sd) / a2} and #{(- b - sd) / a2}"
d == 0 ->
IO.puts " the single root is #{- b / a2}"
true ->
sd = :math.sqrt(-d)
IO.puts " the complex roots are #{- b / a2} +/- #{sd / a2}*i"
end
end
end
Quadratic.roots(1, -2, 1)
Quadratic.roots(1, -3, 2)
Quadratic.roots(1, 0, 1)
Quadratic.roots(1, -1.0e10, 1)
Quadratic.roots(1, 2, 3)
Quadratic.roots(2, -1, -6)
- Output:
Roots of a quadratic function (1, -2, 1) the single root is 1.0 Roots of a quadratic function (1, -3, 2) the real roots are 2.0 and 1.0 Roots of a quadratic function (1, 0, 1) the complex roots are 0.0 +/- 1.0*i Roots of a quadratic function (1, -1.0e10, 1) the real roots are 1.0e10 and 0.0 Roots of a quadratic function (1, 2, 3) the complex roots are -1.0 +/- 1.4142135623730951*i Roots of a quadratic function (2, -1, -6) the real roots are 2.0 and -1.5
ERRE
PROGRAM QUADRATIC
PROCEDURE SOLVE_QUADRATIC
D=B*B-4*A*C
IF ABS(D)<1D-6 THEN D=0 END IF
CASE SGN(D) OF
0->
PRINT("the single root is ";-B/2/A)
END ->
1->
F=(1+SQR(1-4*A*C/(B*B)))/2
PRINT("the real roots are ";-F*B/A;"and ";-C/B/F)
END ->
-1->
PRINT("the complex roots are ";-B/2/A;"+/-";SQR(-D)/2/A;"*i")
END ->
END CASE
END PROCEDURE
BEGIN
PRINT(CHR$(12);) ! CLS
FOR TEST%=1 TO 7 DO
READ(A,B,C)
PRINT("For a=";A;",b=";B;",c=";C;TAB(32);)
SOLVE_QUADRATIC
END FOR
DATA(1,-1E9,1)
DATA(1,0,1)
DATA(2,-1,-6)
DATA(1,2,-2)
DATA(0.5,1.4142135,1)
DATA(1,3,2)
DATA(3,4,5)
END PROGRAM
- Output:
For a= 1 ,b=-1E+09 ,c= 1 the real roots are 1E+09 and 1E-09 For a= 1 ,b= 0 ,c= 1 the complex roots are 0 +/- 1 *i For a= 2 ,b=-1 ,c=-6 the real roots are 2 and -1.5 For a= 1 ,b= 2 ,c=-2 the real roots are -2.732051 and .7320508 For a= .5 ,b= 1.414214 ,c= 1 the single root is -1.414214 For a= 1 ,b= 3 ,c= 2 the real roots are -2 and -1 For a= 3 ,b= 4 ,c= 5 the complex roots are -.6666667 +/- 1.105542 *i
Factor
:: quadratic-equation ( a b c -- x1 x2 )
b sq a c * 4 * - sqrt :> sd
b 0 <
[ b neg sd + a 2 * / ]
[ b neg sd - a 2 * / ] if :> x
x c a x * / ;
( scratchpad ) 1 -1.e20 1 quadratic-equation
--- Data stack:
1.0e+20
9.999999999999999e-21
Middlebrook method
:: quadratic-equation2 ( a b c -- x1 x2 )
a c * sqrt b / :> q
1 4 q sq * - sqrt 0.5 * 0.5 + :> f
b neg a / f * c neg b / f / ;
( scratchpad ) 1 -1.e20 1 quadratic-equation
--- Data stack:
1.0e+20
1.0e-20
Forth
Without locals:
: quadratic ( fa fb fc -- r1 r2 )
frot frot
( c a b )
fover 3 fpick f* -4e f* fover fdup f* f+
( c a b det )
fdup f0< if abort" imaginary roots" then
fsqrt
fover f0< if fnegate then
f+ fnegate
( c a b-det )
2e f/ fover f/
( c a r1 )
frot frot f/ fover f/ ;
With locals:
: quadratic { F: a F: b F: c -- r1 r2 }
b b f* 4e a f* c f* f-
fdup f0< if abort" imaginary roots" then
fsqrt
b f0< if fnegate then b f+ fnegate 2e f/ a f/
c a f/ fover f/ ;
\ test
1 set-precision
1e -1e6 1e quadratic fs. fs. \ 1e-6 1e6
Fortran
Fortran 90
PROGRAM QUADRATIC
IMPLICIT NONE
INTEGER, PARAMETER :: dp = SELECTED_REAL_KIND(15)
REAL(dp) :: a, b, c, e, discriminant, rroot1, rroot2
COMPLEX(dp) :: croot1, croot2
WRITE(*,*) "Enter the coefficients of the equation ax^2 + bx + c"
WRITE(*, "(A)", ADVANCE="NO") "a = "
READ *, a
WRITE(*,"(A)", ADVANCE="NO") "b = "
READ *, b
WRITE(*,"(A)", ADVANCE="NO") "c = "
READ *, c
WRITE(*,"(3(A,E23.15))") "Coefficients are: a = ", a, " b = ", b, " c = ", c
e = 1.0e-9_dp
discriminant = b*b - 4.0_dp*a*c
IF (ABS(discriminant) < e) THEN
rroot1 = -b / (2.0_dp * a)
WRITE(*,*) "The roots are real and equal:"
WRITE(*,"(A,E23.15)") "Root = ", rroot1
ELSE IF (discriminant > 0) THEN
rroot1 = -(b + SIGN(SQRT(discriminant), b)) / (2.0_dp * a)
rroot2 = c / (a * rroot1)
WRITE(*,*) "The roots are real:"
WRITE(*,"(2(A,E23.15))") "Root1 = ", rroot1, " Root2 = ", rroot2
ELSE
croot1 = (-b + SQRT(CMPLX(discriminant))) / (2.0_dp*a)
croot2 = CONJG(croot1)
WRITE(*,*) "The roots are complex:"
WRITE(*,"(2(A,2E23.15,A))") "Root1 = ", croot1, "j ", " Root2 = ", croot2, "j"
END IF
- Output:
Coefficients are: a = 0.300000000000000E+01 b = 0.400000000000000E+01 c = 0.133333333330000E+01 The roots are real and equal: Root = -0.666666666666667E+00 Coefficients are: a = 0.300000000000000E+01 b = 0.200000000000000E+01 c = -0.100000000000000E+01 The roots are real: Root1 = -0.100000000000000E+01 Root2 = 0.333333333333333E+00 Coefficients are: a = 0.300000000000000E+01 b = 0.200000000000000E+01 c = 0.100000000000000E+01 The roots are complex: Root1 = -0.333333333333333E+00 0.471404512723287E+00j Root2 = -0.333333333333333E+00 -0.471404512723287E+00j Coefficients are: a = 0.100000000000000E+01 b = -0.100000000000000E+07 c = 0.100000000000000E+01 The roots are real: Root1 = 0.999999999999000E+06 Root2 = 0.100000000000100E-05
Fortran I
Source code written in FORTRAN I (october 1956) for the IBM 704.
COMPUTE ROOTS OF A QUADRATIC FUNCTION - 1956
READ 100,A,B,C
100 FORMAT(3F8.3)
PRINT 100,A,B,C
DISC=B**2-4.*A*C
IF(DISC),1,2,3
1 XR=-B/(2.*A)
XI=SQRT(-DISC)/(2.*A)
XJ=-XI
PRINT 311
PRINT 312,XR,XI,XR,XJ
311 FORMAT(13HCOMPLEX ROOTS)
312 FORMAT(4HX1=(,2E12.4,6H),X2=(,2E12.4,1H))
GO TO 999
2 X1=-B/(2.*A)
X2=X1
PRINT 321
PRINT 332,X1,X2
321 FORMAT(16HEQUAL REAL ROOTS)
GO TO 999
3 X1= (-B+SQRT(DISC)) / (2.*A)
X2= (-B-SQRT(DISC)) / (2.*A)
PRINT 331
PRINT 332,X1,X2
331 FORMAT(10HREAL ROOTS)
332 FORMAT(3HX1=,E12.5,4H,X2=,E12.5)
999 STOP
FreeBASIC
' version 20-12-2020
' compile with: fbc -s console
#Include Once "gmp.bi"
Sub solvequadratic_n(a As Double ,b As Double, c As Double)
Dim As Double f, d = b ^ 2 - 4 * a * c
Select Case Sgn(d)
Case 0
Print "1: the single root is "; -b / 2 / a
Case 1
Print "1: the real roots are "; (-b + Sqr(d)) / 2 * a; " and ";(-b - Sqr(d)) / 2 * a
Case -1
Print "1: the complex roots are "; -b / 2 / a; " +/- "; Sqr(-d) / 2 / a; "*i"
End Select
End Sub
Sub solvequadratic_c(a As Double ,b As Double, c As Double)
Dim As Double f, d = b ^ 2 - 4 * a * c
Select Case Sgn(d)
Case 0
Print "2: the single root is "; -b / 2 / a
Case 1
f = (1 + Sqr(1 - 4 * a *c / b ^ 2)) / 2
Print "2: the real roots are "; -f * b / a; " and "; -c / b / f
Case -1
Print "2: the complex roots are "; -b / 2 / a; " +/- "; Sqr(-d) / 2 / a; "*i"
End Select
End Sub
Sub solvequadratic_gmp(a_ As Double ,b_ As Double, c_ As Double)
#Define PRECISION 1024 ' about 300 digits
#Define MAX 25
Dim As ZString Ptr text
text = Callocate (1000)
Mpf_set_default_prec(PRECISION)
Dim As Mpf_ptr a, b, c, d, t
a = Allocate(Len(__mpf_struct)) : Mpf_init_set_d(a, a_)
b = Allocate(Len(__mpf_struct)) : Mpf_init_set_d(b, b_)
c = Allocate(Len(__mpf_struct)) : Mpf_init_set_d(c, c_)
d = Allocate(Len(__mpf_struct)) : Mpf_init(d)
t = Allocate(Len(__mpf_struct)) : Mpf_init(t)
mpf_mul(d, b, b)
mpf_set_ui(t, 4)
mpf_mul(t, t, a)
mpf_mul(t, t, c)
mpf_sub(d, d, t)
Select Case mpf_sgn(d)
Case 0
mpf_neg(t, b)
mpf_div_ui(t, t, 2)
mpf_div(t, t, a)
Gmp_sprintf(text,"%.*Fe", MAX, t)
Print "3: the single root is "; *text
Case Is > 0
mpf_sqrt(d, d)
mpf_add(a, a, a)
mpf_neg(t, b)
mpf_add(t, t, d)
mpf_div(t, t, a)
Gmp_sprintf(text,"%.*Fe", MAX, t)
Print "3: the real roots are "; *text; " and ";
mpf_neg(t, b)
mpf_sub(t, t, d)
mpf_div(t, t, a)
Gmp_sprintf(text,"%.*Fe", MAX, t)
Print *text
Case Is < 0
mpf_neg(t, b)
mpf_div_ui(t, t, 2)
mpf_div(t, t, a)
Gmp_sprintf(text,"%.*Fe", MAX, t)
Print "3: the complex roots are "; *text; " +/- ";
mpf_neg(t, d)
mpf_sqrt(t, t)
mpf_div_ui(t, t, 2)
mpf_div(t, t, a)
Gmp_sprintf(text,"%.*Fe", MAX, t)
Print *text; "*i"
End Select
End Sub
' ------=< MAIN >=------
Dim As Double a, b, c
Print "1: is the naieve way"
Print "2: is the cautious way"
Print "3: is the naieve way with help of GMP"
Print
For i As Integer = 1 To 10
Read a, b, c
Print "Find root(s) for "; Str(a); "X^2"; IIf(b < 0, "", "+");
Print Str(b); "X"; IIf(c < 0, "", "+"); Str(c)
solvequadratic_n(a, b , c)
solvequadratic_c(a, b , c)
solvequadratic_gmp(a, b , c)
Print
Next
' empty keyboard buffer
While Inkey <> "" : Wend
Print : Print "hit any key to end program"
Sleep
End
Data 1, -1E9, 1
Data 1, 0, 1
Data 2, -1, -6
Data 1, 2, -2
Data 0.5, 1.4142135623731, 1
Data 1, 3, 2
Data 3, 4, 5
Data 1, -1e100, 1
Data 1, -1e200, 1
Data 1, -1e300, 1
- Output:
1: is the naieve way 2: is the cautious way 3: is the naieve way with help of GMP Find root(s) for 1X^2-1000000000X+1 1: the real roots are 1000000000 and 0 2: the real roots are 1000000000 and 1e-009 3: the real roots are 9.9999999999999999900000000e+08 and 1.0000000000000000010000000e-09 Find root(s) for 1X^2+0X+1 1: the complex roots are -0 +/- 1*i 2: the complex roots are -0 +/- 1*i 3: the complex roots are 0.0000000000000000000000000e+00 +/- 1.0000000000000000000000000e+00*i Find root(s) for 2X^2-1X-6 1: the real roots are 8 and -6 2: the real roots are 2 and -1.5 3: the real roots are 2.0000000000000000000000000e+00 and -1.5000000000000000000000000e+00 Find root(s) for 1X^2+2X-2 1: the real roots are 0.7320508075688772 and -2.732050807568877 2: the real roots are -2.732050807568877 and 0.7320508075688773 3: the real roots are 7.3205080756887729352744634e-01 and -2.7320508075688772935274463e+00 Find root(s) for 0.5X^2+1.4142135623731X+1 1: the real roots are -0.3535533607909526 and -0.3535534203955974 2: the real roots are -1.414213681582389 and -1.414213443163811 3: the real roots are -1.4142134436707580875788206e+00 and -1.4142136810754419733330398e+00 Find root(s) for 1X^2+3X+2 1: the real roots are -1 and -2 2: the real roots are -2 and -0.9999999999999999 3: the real roots are -1.0000000000000000000000000e+00 and -2.0000000000000000000000000e+00 Find root(s) for 3X^2+4X+5 1: the complex roots are -0.6666666666666666 +/- 1.105541596785133*i 2: the complex roots are -0.6666666666666666 +/- 1.105541596785133*i 3: the complex roots are -6.6666666666666666666666667e-01 +/- 1.1055415967851332830383109e+00*i Find root(s) for 1X^2-1e+100X+1 1: the real roots are 1e+100 and 0 2: the real roots are 1e+100 and 1e-100 3: the real roots are 1.0000000000000000159028911e+100 and 9.9999999999999998409710889e-101 Find root(s) for 1X^2-1e+200X+1 1: the real roots are 1.#INF and -1.#INF 2: the real roots are 1e+200 and 1e-200 3: the real roots are 9.9999999999999996973312221e+199 and 0.0000000000000000000000000e+00 Find root(s) for 1X^2-1e+300X+1 1: the real roots are 1.#INF and -1.#INF 2: the real roots are 1e+300 and 1e-300 3: the real roots are 1.0000000000000000525047603e+300 and 0.0000000000000000000000000e+00
GAP
QuadraticRoots := function(a, b, c)
local d;
d := Sqrt(b*b - 4*a*c);
return [ (-b+d)/(2*a), (-b-d)/(2*a) ];
end;
# Hint : E(12) is a 12th primitive root of 1
QuadraticRoots(2, 2, -1);
# [ 1/2*E(12)^4-1/2*E(12)^7+1/2*E(12)^8+1/2*E(12)^11,
# 1/2*E(12)^4+1/2*E(12)^7+1/2*E(12)^8-1/2*E(12)^11 ]
# This works also with floating-point numbers
QuadraticRoots(2.0, 2.0, -1.0);
# [ 0.366025, -1.36603 ]
Go
package main
import (
"fmt"
"math"
)
func qr(a, b, c float64) ([]float64, []complex128) {
d := b*b-4*a*c
switch {
case d == 0:
// single root
return []float64{-b/(2*a)}, nil
case d > 0:
// two real roots
if b < 0 {
d = math.Sqrt(d)-b
} else {
d = -math.Sqrt(d)-b
}
return []float64{d/(2*a), (2*c)/d}, nil
case d < 0:
// two complex roots
den := 1/(2*a)
t1 := complex(-b*den, 0)
t2 := complex(0, math.Sqrt(-d)*den)
return nil, []complex128{t1+t2, t1-t2}
}
// otherwise d overflowed or a coefficient was NAN
return []float64{d}, nil
}
func test(a, b, c float64) {
fmt.Print("coefficients: ", a, b, c, " -> ")
r, i := qr(a, b, c)
switch len(r) {
case 1:
fmt.Println("one real root:", r[0])
case 2:
fmt.Println("two real roots:", r[0], r[1])
default:
fmt.Println("two complex roots:", i[0], i[1])
}
}
func main() {
for _, c := range [][3]float64{
{1, -2, 1},
{1, 0, 1},
{1, -10, 1},
{1, -1000, 1},
{1, -1e9, 1},
} {
test(c[0], c[1], c[2])
}
}
- Output:
coefficients: 1 -2 1 -> one real root: 1 coefficients: 1 0 1 -> two complex roots: (0+1i) (-0-1i) coefficients: 1 -10 1 -> two real roots: 9.898979485566356 0.10102051443364381 coefficients: 1 -1000 1 -> two real roots: 999.998999999 0.001000001000002 coefficients: 1 -1e+09 1 -> two real roots: 1e+09 1e-09
Haskell
import Data.Complex (Complex, realPart)
type CD = Complex Double
quadraticRoots :: (CD, CD, CD) -> (CD, CD)
quadraticRoots (a, b, c)
| 0 < realPart b =
( (2 * c) / (- b - d),
(- b - d) / (2 * a)
)
| otherwise =
( (- b + d) / (2 * a),
(2 * c) / (- b + d)
)
where
d = sqrt $ b ^ 2 - 4 * a * c
main :: IO ()
main =
mapM_
(print . quadraticRoots)
[ (3, 4, 4 / 3),
(3, 2, -1),
(3, 2, 1),
(1, -10e5, 1),
(1, -10e9, 1)
]
- Output:
((-0.6666666666666666) :+ 0.0,(-0.6666666666666666) :+ 0.0) (0.3333333333333333 :+ 0.0,(-1.0) :+ 0.0) ((-0.33333333333333326) :+ 0.4714045207910316,(-0.3333333333333333) :+ (-0.47140452079103173)) (999999.999999 :+ 0.0,1.000000000001e-6 :+ 0.0) (1.0e10 :+ 0.0,1.0e-10 :+ 0.0)
Icon and Unicon
Works in both languages.
procedure main()
solve(1.0, -10.0e5, 1.0)
end
procedure solve(a,b,c)
d := sqrt(b*b - 4.0*a*c)
roots := if b < 0 then [r1 := (-b+d)/(2.0*a), c/(a*r1)]
else [r1 := (-b-d)/(2.0*a), c/(a*r1)]
write(a,"*x^2 + ",b,"*x + ",c," has roots ",roots[1]," and ",roots[2])
end
- Output:
->rqf 1.0 -0.000000001 1.0 1.0*x^2 + -1000000.0*x + 1.0 has roots 999999.999999 and 1.000000000001e-06 ->
IDL
compile_OPT IDL2
print, "input a, press enter, input b, press enter, input c, press enter"
read,a,b,c
Promt='Enter values of a,b,c and hit enter'
a0=0.0
b0=0.0
c0=0.0 ;make them floating point variables
x=-b+sqrt((b^2)-4*a*c)
y=-b-sqrt((b^2)-4*a*c)
z=2*a
d= x/z
e= y/z
print, d,e
IS-BASIC
100 PROGRAM "Quadratic.bas"
110 PRINT "Enter coefficients a, b and c:":INPUT PROMPT "a= ,b= ,c= ":A,B,C
120 IF A=0 THEN
130 PRINT "The coefficient of x^2 can not be 0."
140 ELSE
150 LET D=B^2-4*A*C
160 SELECT CASE SGN(D)
170 CASE 0
180 PRINT "The single root is ";-B/2/A
190 CASE 1
200 PRINT "The real roots are ";(-B+SQR(D))/(2*A);"and ";(-B-SQR(D))/(2*A)
210 CASE -1
220 PRINT "The complex roots are ";-B/2/A;"+/- ";STR$(SQR(-D)/2/A);"*i"
230 END SELECT
240 END IF
J
Solution use J's built-in polynomial solver:
p.
This primitive converts between the coefficient form of a polynomial (with the exponents being the array indices of the coefficients) and the multiplier-and-roots for of a polynomial (with two boxes, the first containing the multiplier and the second containing the roots).
Example using inputs from other solutions and the unstable example from the task description:
coeff =. _3 |.\ 3 4 4r3 3 2 _1 3 2 1 1 _1e6 1 1 _1e9 1
> {:"1 p. coeff
_0.666667 _0.666667
_1 0.333333
_0.333333j0.471405 _0.333333j_0.471405
1e6 1e_6
1e9 1e_9
Of course p.
generalizes to polynomials of arbitrary order (which isn't as great as that might sound, because of practical limitations). Given the coefficients p.
returns the multiplier and roots of the polynomial. Given the multiplier and roots it returns the coefficients. For example using the cubic :
p. 0 16 _12 2 NB. return multiplier ; roots
+-+-----+
|2|4 2 0|
+-+-----+
p. 2 ; 4 2 0 NB. return coefficients
0 16 _12 2
Exploring the limits of precision:
1{::p. 1 _1e5 1 NB. display roots
100000 1e_5
1 _1e5 1 p. 1{::p. 1 _1e5 1 NB. test roots
_3.38436e_7 0
1 _1e5 1 p. 1e5 1e_5 NB. test displayed roots
1 9.99999e_11
1e5 1e_5 - 1{::p. 1 _1e5 1 NB. find difference
1e_5 _1e_15
1 _1e5 1 p. 1e5 1e_5-1e_5 _1e_15 NB. test displayed roots with adjustment
_3.38436e_7 0
When these "roots" are plugged back into the original polynomial, the results are nowhere near zero. However, double precision floating point does not have enough bits to represent the (extremely close) answers that would give a zero result.
Middlebrook formula implemented in J
q_r=: verb define
'a b c' =. y
q=. b %~ %: a * c
f=. 0.5 + 0.5 * %:(1-4*q*q)
(-b*f%a),(-c%b*f)
)
q_r 1 _1e6 1
1e6 1e_6
Java
public class QuadraticRoots {
private static class Complex {
double re, im;
public Complex(double re, double im) {
this.re = re;
this.im = im;
}
@Override
public boolean equals(Object obj) {
if (obj == this) {return true;}
if (!(obj instanceof Complex)) {return false;}
Complex other = (Complex) obj;
return (re == other.re) && (im == other.im);
}
@Override
public String toString() {
if (im == 0.0) {return String.format("%g", re);}
if (re == 0.0) {return String.format("%gi", im);}
return String.format("%g %c %gi", re,
(im < 0.0 ? '-' : '+'), Math.abs(im));
}
}
private static Complex[] quadraticRoots(double a, double b, double c) {
Complex[] roots = new Complex[2];
double d = b * b - 4.0 * a * c; // discriminant
double aa = a + a;
if (d < 0.0) {
double re = -b / aa;
double im = Math.sqrt(-d) / aa;
roots[0] = new Complex(re, im);
roots[1] = new Complex(re, -im);
} else if (b < 0.0) {
// Avoid calculating -b - Math.sqrt(d), to avoid any
// subtractive cancellation when it is near zero.
double re = (-b + Math.sqrt(d)) / aa;
roots[0] = new Complex(re, 0.0);
roots[1] = new Complex(c / (a * re), 0.0);
} else {
// Avoid calculating -b + Math.sqrt(d).
double re = (-b - Math.sqrt(d)) / aa;
roots[1] = new Complex(re, 0.0);
roots[0] = new Complex(c / (a * re), 0.0);
}
return roots;
}
public static void main(String[] args) {
double[][] equations = {
{1.0, 22.0, -1323.0}, // two distinct real roots
{6.0, -23.0, 20.0}, // with a != 1.0
{1.0, -1.0e9, 1.0}, // with one root near zero
{1.0, 2.0, 1.0}, // one real root (double root)
{1.0, 0.0, 1.0}, // two imaginary roots
{1.0, 1.0, 1.0} // two complex roots
};
for (int i = 0; i < equations.length; i++) {
Complex[] roots = quadraticRoots(
equations[i][0], equations[i][1], equations[i][2]);
System.out.format("%na = %g b = %g c = %g%n",
equations[i][0], equations[i][1], equations[i][2]);
if (roots[0].equals(roots[1])) {
System.out.format("X1,2 = %s%n", roots[0]);
} else {
System.out.format("X1 = %s%n", roots[0]);
System.out.format("X2 = %s%n", roots[1]);
}
}
}
}
- Output:
a = 1.00000 b = 22.0000 c = -1323.00 X1 = 27.0000 X2 = -49.0000 a = 6.00000 b = -23.0000 c = 20.0000 X1 = 2.50000 X2 = 1.33333 a = 1.00000 b = -1.00000e+09 c = 1.00000 X1 = 1.00000e+09 X2 = 1.00000e-09 a = 1.00000 b = 2.00000 c = 1.00000 X1,2 = -1.00000 a = 1.00000 b = 0.00000 c = 1.00000 X1 = 1.00000i X2 = -1.00000i a = 1.00000 b = 1.00000 c = 1.00000 X1 = -0.500000 + 0.866025i X2 = -0.500000 - 0.866025i
jq
Currently jq does not include support for complex number operations, so a small library is included in the first section.
The second section defines quadratic_roots(a;b;c), which emits a stream of 0 or two solutions, or the value true if a==b==c==0.
The third section defines a function for producing a table showing (i, error, solution) for solutions to x^2 - 10^i + 1 = 0 for various values of i.
Section 1: Complex numbers (scrolling window)
# Complex numbers as points [x,y] in the Cartesian plane
def real(z): if (z|type) == "number" then z else z[0] end;
def imag(z): if (z|type) == "number" then 0 else z[1] end;
def plus(x; y):
if (x|type) == "number" then
if (y|type) == "number" then [ x+y, 0 ]
else [ x + y[0], y[1]]
end
elif (y|type) == "number" then plus(y;x)
else [ x[0] + y[0], x[1] + y[1] ]
end;
def multiply(x; y):
if (x|type) == "number" then
if (y|type) == "number" then [ x*y, 0 ]
else [x * y[0], x * y[1]]
end
elif (y|type) == "number" then multiply(y;x)
else [ x[0] * y[0] - x[1] * y[1], x[0] * y[1] + x[1] * y[0]]
end;
def negate(x): multiply(-1; x);
def minus(x; y): plus(x; multiply(-1; y));
def conjugate(z):
if (z|type) == "number" then [z, 0]
else [z[0], -(z[1]) ]
end;
def invert(z):
if (z|type) == "number" then [1/z, 0]
else
( (z[0] * z[0]) + (z[1] * z[1]) ) as $d
# use "0 + ." to convert -0 back to 0
| [ z[0]/$d, (0 + -(z[1]) / $d)]
end;
def divide(x;y): multiply(x; invert(y));
def magnitude(z):
real( multiply(z; conjugate(z))) | sqrt;
# exp^z
def complex_exp(z):
def expi(x): [ (x|cos), (x|sin) ];
if (z|type) == "number" then z|exp
elif z[0] == 0 then expi(z[1]) # for efficiency
else multiply( (z[0]|exp); expi(z[1]) )
end ;
def complex_sqrt(z):
if imag(z) == 0 and real(z) >= 0 then [(real(z)|sqrt), 0]
else
magnitude(z) as $r
| if $r == 0 then [0,0]
else
(real(z)/$r) as $a
| (imag(z)/$r) as $b
| $r | sqrt as $r
| (($a | acos) / 2)
| [ ($r * cos), ($r * sin)]
end
end ;
Section 2: quadratic_roots(a;b;c)
# If there are infinitely many solutions, emit true;
# if none, emit empty;
# otherwise always emit two.
# For numerical accuracy, Middlebrook's approach is adopted:
def quadratic_roots(a; b; c):
if a == 0 and b == 0 then
if c == 0 then true # infinitely many
else empty # none
end
elif a == 0 then [-c/b, 0]
elif b == 0 then (complex_sqrt(1/a) | (., negate(.)))
else
divide( plus(1.0; complex_sqrt( minus(1.0; (4 * a * c / (b*b))))); 2) as $f
| negate(divide(multiply(b; $f); a)),
negate(divide(c; multiply(b; $f)))
end
;
Section 3: Produce a table showing [i, error, solution] for solutions to x^2 - 10^i + 1 = 0
def example:
def pow(i): . as $in | reduce range(0;i) as $i (1; . * $in);
def poly(a;b;c): plus( plus( multiply(a; multiply(.;.)); multiply(b;.)); c);
def abs: if . < 0 then -. else . end;
def zero(z):
if z == 0 then 0
else (magnitude(z)|abs) as $zero
| if $zero < 1e-10 then "+0" else $zero end
end;
def lpad(n): tostring | (n - length) * " " + .;
range(0; 13) as $i
| (- (10|pow($i))) as $b
| quadratic_roots(1; $b; 1) as $x
| $x | poly(1; $b; 1) as $zero
| "\($i|lpad(4)): error = \(zero($zero)|lpad(18)) x=\($x)"
;
example
- Output:
(scrolling window)
$ jq -M -r -n -f Roots_of_a_quadratic_function.jq
0: error = +0 x=[0.5,0.8660254037844386]
0: error = +0 x=[0.5000000000000001,-0.8660254037844387]
1: error = +0 x=[9.898979485566356,0]
1: error = +0 x=[0.10102051443364382,-0]
2: error = +0 x=[99.98999899979995,0]
2: error = +0 x=[0.010001000200050014,-0]
3: error = 1.1641532182693481e-10 x=[999.998999999,0]
3: error = +0 x=[0.0010000010000019998,-0]
4: error = +0 x=[9999.999899999999,0]
4: error = +0 x=[0.00010000000100000003,-0]
5: error = +0 x=[99999.99999,0]
5: error = +0 x=[1.0000000001e-05,-0]
6: error = 0.0001220703125 x=[999999.9999989999,0]
6: error = +0 x=[1.000000000001e-06,-0]
7: error = 0.015625 x=[9999999.9999999,0]
7: error = +0 x=[1.0000000000000101e-07,-0]
8: error = 1 x=[99999999.99999999,0]
8: error = +0 x=[1e-08,-0]
9: error = 1 x=[1000000000,0]
9: error = +0 x=[1e-09,-0]
10: error = 1 x=[10000000000,0]
10: error = +0 x=[1e-10,-0]
11: error = 1 x=[100000000000,0]
11: error = +0 x=[1e-11,-0]
12: error = 1 x=[1000000000000,0]
12: error = +0 x=[1e-12,-0]
Julia
This solution is an implementation of algorithm from the Goldberg paper cited in the task description. It does check for a=0 and returns the linear solution in that case. Julia's sqrt throws a domain error for negative real inputs, so negative discriminants are converted to complex by adding 0im prior to taking the square root.
Alternative solutions might make use of Julia's Polynomials or Roots packages.
using Printf
function quadroots(x::Real, y::Real, z::Real)
a, b, c = promote(float(x), y, z)
if a ≈ 0.0 return [-c / b] end
Δ = b ^ 2 - 4a * c
if Δ ≈ 0.0 return [-sqrt(c / a)] end
if Δ < 0.0 Δ = complex(Δ) end
d = sqrt(Δ)
if b < 0.0
d -= b
return [d / 2a, 2c / d]
else
d = -d - b
return [2c / d, d / 2a]
end
end
a = [1, 1, 1.0, 10]
b = [10, 2, -10.0 ^ 9, 1]
c = [1, 1, 1, 1]
for (x, y, z) in zip(a, b, c)
@printf "The roots of %.2fx² + %.2fx + %.2f\n\tx₀ = (%s)\n" x y z join(round.(quadroots(x, y, z), 2), ", ")
end
- Output:
The roots of 1.00x² + 10.00x + 1.00 x₀ = (-0.1, -9.9) The roots of 1.00x² + 2.00x + 1.00 x₀ = (-1.0) The roots of 1.00x² + -1000000000.00x + 1.00 x₀ = (1.0e9, 0.0) The roots of 10.00x² + 1.00x + 1.00 x₀ = (-0.05 + 0.31im, -0.05 - 0.31im)
K
K6
/ naive method
/ sqr[x] and sqrt[x] must be provided
quf:{[a;b;c]; s:sqrt[sqr[b]-4*a*c];(-b+s;-b-s)%2*a}
quf[0.5;-2.5;2]
1.0 4.0
quf[1;8;15]
-5.0 -3.0
quf[1;10;1]
-9.898979485566356 -0.10102051443364424
Kotlin
import java.lang.Math.*
data class Equation(val a: Double, val b: Double, val c: Double) {
data class Complex(val r: Double, val i: Double) {
override fun toString() = when {
i == 0.0 -> r.toString()
r == 0.0 -> "${i}i"
else -> "$r + ${i}i"
}
}
data class Solution(val x1: Any, val x2: Any) {
override fun toString() = when(x1) {
x2 -> "X1,2 = $x1"
else -> "X1 = $x1, X2 = $x2"
}
}
val quadraticRoots by lazy {
val _2a = a + a
val d = b * b - 4.0 * a * c // discriminant
if (d < 0.0) {
val r = -b / _2a
val i = sqrt(-d) / _2a
Solution(Complex(r, i), Complex(r, -i))
} else {
// avoid calculating -b +/- sqrt(d), to avoid any
// subtractive cancellation when it is near zero.
val r = if (b < 0.0) (-b + sqrt(d)) / _2a else (-b - sqrt(d)) / _2a
Solution(r, c / (a * r))
}
}
}
fun main(args: Array<String>) {
val equations = listOf(Equation(1.0, 22.0, -1323.0), // two distinct real roots
Equation(6.0, -23.0, 20.0), // with a != 1.0
Equation(1.0, -1.0e9, 1.0), // with one root near zero
Equation(1.0, 2.0, 1.0), // one real root (double root)
Equation(1.0, 0.0, 1.0), // two imaginary roots
Equation(1.0, 1.0, 1.0)) // two complex roots
equations.forEach { println("$it\n" + it.quadraticRoots) }
}
- Output:
Equation(a=1.0, b=22.0, c=-1323.0) X1 = -49.0, X2 = 27.0 Equation(a=6.0, b=-23.0, c=20.0) X1 = 2.5, X2 = 1.3333333333333333 Equation(a=1.0, b=-1.0E9, c=1.0) X1 = 1.0E9, X2 = 1.0E-9 Equation(a=1.0, b=2.0, c=1.0) X1,2 = -1.0 Equation(a=1.0, b=0.0, c=1.0) X1 = 1.0i, X2 = -1.0i Equation(a=1.0, b=1.0, c=1.0) X1 = -0.5 + 0.8660254037844386i, X2 = -0.5 + -0.8660254037844386i
lambdatalk
1) using lambdas:
{def equation
{lambda {:a :b :c}
{b equation :a*x{sup 2}+:b*x+:c=0}
{{lambda {:a' :b' :d}
{if {> :d 0}
then {{lambda {:b' :d'}
{equation.disp {+ :b' :d'} {- :b' :d'} 2 real roots}
} :b' {/ {sqrt :d} :a'}}
else {if {< :d 0}
then {{lambda {:b' :d'}
{equation.disp [:b',:d'] [:b',-:d'] 2 complex roots}
} :b' {/ {sqrt {- :d}} :a'} }
else {equation.disp :b' :b' one real double root}
}}
} {* 2 :a} {/ {- :b} {* 2 :a}} {- {* :b :b} {* 4 :a :c}} } }}
2) using let:
{def equation
{lambda {:a :b :c}
{b equation :a*x{sup 2}+:b*x+:c=0}
{let { {:a' {* 2 :a}}
{:b' {/ {- :b} {* 2 :a}}}
{:d {- {* :b :b} {* 4 :a :c}}} }
{if {> :d 0}
then {let { {:b' :b'}
{:d' {/ {sqrt :d} :a'}} }
{equation.disp {+ :b' :d'} {- :b' :d'} 2 real roots} }
else {if {< :d 0}
then {let { {:b' :b'}
{:d' {/ {sqrt {- :d}} :a'}} }
{equation.disp [:b',:d'] [:b',-:d'] 2 complex roots} }
else {equation.disp :b' :b' one real double root} }} }}}
3) a function to display results in an HTML table format
{def equation.disp
{lambda {:x1 :x2 :txt}
{table {@ style="background:#ffa"}
{tr {td :txt: }}
{tr {td x1 = :x1 }}
{tr {td x2 = :x2 }} } }}
4) testing:
equation 1*x2+1*x+-1=0
2 real roots:
x1 = 0.6180339887498949
x2 = -1.618033988749895
equation 1*x2+1*x+1=0
2 complex roots:
x1 = [-0.5,0.8660254037844386]
x2 = [-0.5,-0.8660254037844386]
equation 1*x2+-2*x+1=0
one real double root:
x1 = 1
x2 = 1
Liberty BASIC
a=1:b=2:c=3
'assume a<>0
print quad$(a,b,c)
end
function quad$(a,b,c)
D=b^2-4*a*c
x=-1*b
if D<0 then
quad$=str$(x/(2*a));" +i";str$(sqr(abs(D))/(2*a));" , ";str$(x/(2*a));" -i";str$(sqr(abs(D))/abs(2*a))
else
quad$=str$(x/(2*a)+sqr(D)/(2*a));" , ";str$(x/(2*a)-sqr(D)/(2*a))
end if
end function
Logo
to quadratic :a :b :c
localmake "d sqrt (:b*:b - 4*:a*:c)
if :b < 0 [make "d minus :d]
output list (:d-:b)/(2*:a) (2*:c)/(:d-:b)
end
Lua
In order to correctly handle complex roots, qsolve must be given objects from a suitable complex number library, like that from the Complex Numbers article. However, this should be enough to demonstrate its accuracy:
function qsolve(a, b, c)
if b < 0 then return qsolve(-a, -b, -c) end
val = b + (b^2 - 4*a*c)^(1/2) --this never exhibits instability if b > 0
return -val / (2 * a), -2 * c / val --2c / val is the same as the "unstable" second root
end
for i = 1, 12 do
print(qsolve(1, 0-10^i, 1))
end
The "trick" lies in avoiding subtracting large values that differ by a small amount, which is the source of instability in the "normal" formula. It is trivial to prove that 2c/(b + sqrt(b^2-4ac)) = (b - sqrt(b^2-4ac))/2a.
Maple
solve(a*x^2+b*x+c,x);
solve(1.0*x^2-10.0^9*x+1.0,x,explicit,allsolutions);
fsolve(x^2-10^9*x+1,x,complex);
- Output:
(1/2) (1/2) / 2\ / 2\ -b + \-4 a c + b / b + \-4 a c + b / -----------------------, - ---------------------- 2 a 2 a 9 -9 1.000000000 10 , 1.000000000 10 -9 9 1.000000000 10 , 1.000000000 10
Mathematica/Wolfram Language
Possible ways to do this are (symbolic and numeric examples):
Solve[a x^2 + b x + c == 0, x]
Solve[x^2 - 10^5 x + 1 == 0, x]
Root[#1^2 - 10^5 #1 + 1 &, 1]
Root[#1^2 - 10^5 #1 + 1 &, 2]
Reduce[a x^2 + b x + c == 0, x]
Reduce[x^2 - 10^5 x + 1 == 0, x]
FindInstance[x^2 - 10^5 x + 1 == 0, x, Reals, 2]
FindRoot[x^2 - 10^5 x + 1 == 0, {x, 0}]
FindRoot[x^2 - 10^5 x + 1 == 0, {x, 10^6}]
gives back:
Note that some functions do not really give the answer (like reduce) rather it gives another way of writing it (boolean expression). However note that reduce gives the explicit cases for a zero and nonzero, b zero and nonzero, et cetera. Some functions are numeric by nature, other can handle both symbolic and numeric. In generals the solution will be exact if the input is exact. Any exact result can be approximated to arbitrary precision using the function N[expression,number of digits]. Further notice that some functions give back exact answers in a different form then others, however the answers are both correct, the answers are just written differently.
MATLAB / Octave
roots([1 -3 2]) % coefficients in decreasing order of power e.g. [x^n ... x^2 x^1 x^0]
Maxima
solve(a*x^2 + b*x + c = 0, x);
/* 2 2
sqrt(b - 4 a c) + b sqrt(b - 4 a c) - b
[x = - --------------------, x = --------------------]
2 a 2 a */
fpprec: 40$
solve(x^2 - 10^9*x + 1 = 0, x);
/* [x = 500000000 - sqrt(249999999999999999),
x = sqrt(249999999999999999) + 500000000] */
bfloat(%);
/* [x = 1.0000000000000000009999920675269450501b-9,
x = 9.99999999999999998999999999999999999b8] */
МК-61/52
П2 С/П /-/ <-> / 2 / П3 x^2 С/П
ИП2 / - Вx <-> КвКор НОП x>=0 28 ИП3
x<0 24 <-> /-/ + / Вx С/П /-/ КвКор
ИП3 С/П
Input: a С/П b С/П c С/П
- Output:
x1 - РX; x2 - РY (or error message, if D < 0).
Modula-3
MODULE Quad EXPORTS Main;
IMPORT IO, Fmt, Math;
TYPE Roots = ARRAY [1..2] OF LONGREAL;
VAR r: Roots;
PROCEDURE Solve(a, b, c: LONGREAL): Roots =
VAR sd: LONGREAL := Math.sqrt(b * b - 4.0D0 * a * c);
x: LONGREAL;
BEGIN
IF b < 0.0D0 THEN
x := (-b + sd) / (2.0D0 * a);
RETURN Roots{x, c / (a * x)};
ELSE
x := (-b - sd) / (2.0D0 * a);
RETURN Roots{c / (a * x), x};
END;
END Solve;
BEGIN
r := Solve(1.0D0, -10.0D5, 1.0D0);
IO.Put("X1 = " & Fmt.LongReal(r[1]) & " X2 = " & Fmt.LongReal(r[2]) & "\n");
END Quad.
Nim
import math, complex, strformat
const Epsilon = 1e-15
type
SolKind = enum solDouble, solFloat, solComplex
Roots = object
case kind: SolKind
of solDouble:
fvalue: float
of solFloat:
fvalues: (float, float)
of solComplex:
cvalues: (Complex64, Complex64)
func quadRoots(a, b, c: float): Roots =
if a == 0:
raise newException(ValueError, "first coefficient cannot be null.")
let den = a * 2
let Δ = b * b - a * c * 4
if abs(Δ) < Epsilon:
result = Roots(kind: solDouble, fvalue: -b / den)
elif Δ < 0:
let r = -b / den
let i = sqrt(-Δ) / den
result = Roots(kind: solComplex, cvalues: (complex64(r, i), complex64(r, -i)))
else:
let r = (if b < 0: -b + sqrt(Δ) else: -b - sqrt(Δ)) / den
result = Roots(kind: solFloat, fvalues: (r, c / (a * r)))
func `$`(r: Roots): string =
case r.kind
of solDouble:
result = $r.fvalue
of solFloat:
result = &"{r.fvalues[0]}, {r.fvalues[1]}"
of solComplex:
result = &"{r.cvalues[0].re} + {r.cvalues[0].im}i, {r.cvalues[1].re} + {r.cvalues[1].im}i"
when isMainModule:
const Equations = [(1.0, -2.0, 1.0),
(10.0, 1.0, 1.0),
(1.0, -10.0, 1.0),
(1.0, -1000.0, 1.0),
(1.0, -1e9, 1.0)]
for (a, b, c) in Equations:
echo &"Equation: {a=}, {b=}, {c=}"
let roots = quadRoots(a, b, c)
let plural = if roots.kind == solDouble: "" else: "s"
echo &" root{plural}: {roots}"
- Output:
Equation: a=1.0, b=-2.0, c=1.0 root: 1.0 Equation: a=10.0, b=1.0, c=1.0 roots: -0.05 + 0.3122498999199199i, -0.05 + -0.3122498999199199i Equation: a=1.0, b=-10.0, c=1.0 roots: 9.898979485566356, 0.1010205144336438 Equation: a=1.0, b=-1000.0, c=1.0 roots: 999.998999999, 0.001000001000002 Equation: a=1.0, b=-1000000000.0, c=1.0 roots: 1000000000.0, 1e-09
OCaml
type quadroots =
| RealRoots of float * float
| ComplexRoots of Complex.t * Complex.t ;;
let quadsolve a b c =
let d = (b *. b) -. (4.0 *. a *. c) in
if d < 0.0
then
let r = -. b /. (2.0 *. a)
and i = sqrt(-. d) /. (2.0 *. a) in
ComplexRoots ({ Complex.re = r; Complex.im = i },
{ Complex.re = r; Complex.im = (-.i) })
else
let r =
if b < 0.0
then ((sqrt d) -. b) /. (2.0 *. a)
else ((sqrt d) +. b) /. (-2.0 *. a)
in
RealRoots (r, c /. (r *. a))
;;
- Output:
# quadsolve 1.0 0.0 (-2.0) ;;
- : quadroots = RealRoots (-1.4142135623730951, 1.4142135623730949)
# quadsolve 1.0 0.0 2.0 ;;
- : quadroots =
ComplexRoots ({Complex.re = 0.; Complex.im = 1.4142135623730951},
{Complex.re = 0.; Complex.im = -1.4142135623730951})
# quadsolve 1.0 (-1.0e5) 1.0 ;;
- : quadroots = RealRoots (99999.99999, 1.0000000001000001e-005)
Octave
See MATLAB.
PARI/GP
roots(a,b,c)=polrootsreal(Pol([a,b,c]))
Otherwise, coding directly:
roots(a,b,c)={
b /= a;
c /= a;
my (delta = b^2 - 4*c, root=sqrt(delta));
if (delta < 0,
[root-b,-root-b]/2
,
my(sol=if(b>0, -b - root,-b + root)/2);
[sol,c/sol]
)
};
Either way,
roots(1,-1e9,1)
gives one root around 0.000000001000000000000000001 and one root around 999999999.999999999.
Pascal
some parts translated from Modula2
Program QuadraticRoots;
var
a, b, c, q, f: double;
begin
a := 1;
b := -10e9;
c := 1;
q := sqrt(a * c) / b;
f := (1 + sqrt(1 - 4 * q * q)) / 2;
writeln ('Version 1:');
writeln ('x1: ', (-b * f / a):16, ', x2: ', (-c / (b * f)):16);
writeln ('Version 2:');
q := sqrt(b * b - 4 * a * c);
if b < 0 then
begin
f := (-b + q) / 2 * a;
writeln ('x1: ', f:16, ', x2: ', (c / (a * f)):16);
end
else
begin
f := (-b - q) / 2 * a;
writeln ('x1: ', (c / (a * f)):16, ', x2: ', f:16);
end;
end.
- Output:
Version 1: x1: 1.00000000E+010, x2: 1.00000000E-010 Version 2: x1: 1.00000000E+010, x2: 1.00000000E-010
Perl
When using Math::Complex perl automatically convert numbers when necessary.
use Math::Complex;
($x1,$x2) = solveQuad(1,2,3);
print "x1 = $x1, x2 = $x2\n";
sub solveQuad
{
my ($a,$b,$c) = @_;
my $root = sqrt($b**2 - 4*$a*$c);
return ( -$b + $root )/(2*$a), ( -$b - $root )/(2*$a);
}
Phix
procedure solve_quadratic(sequence t3) atom {a,b,c} = t3, d = b*b-4*a*c, f string s = sprintf("for a=%g,b=%g,c=%g",t3), t sequence u if abs(d)<1e-6 then d=0 end if switch sign(d) do case 0: t = "single root is %g" u = {-b/2/a} case 1: t = "real roots are %g and %g" f = (1+sqrt(1-4*a*c/(b*b)))/2 u = {-f*b/a,-c/b/f} case-1: t = "complex roots are %g +/- %g*i" u = {-b/2/a,sqrt(-d)/2/a} end switch printf(1,"%-25s the %s\n",{s,sprintf(t,u)}) end procedure constant tests = {{1,-1E9,1}, {1,0,1}, {2,-1,-6}, {1,2,-2}, {0.5,1.4142135,1}, {1,3,2}, {3,4,5}} papply(tests,solve_quadratic)
for a=1,b=-1e+9,c=1 the real roots are 1e+9 and 1e-9 for a=1,b=0,c=1 the complex roots are 0 +/- 1*i for a=2,b=-1,c=-6 the real roots are 2 and -1.5 for a=1,b=2,c=-2 the real roots are -2.73205 and 0.732051 for a=0.5,b=1.41421,c=1 the single root is -1.41421 for a=1,b=3,c=2 the real roots are -2 and -1 for a=3,b=4,c=5 the complex roots are -0.666667 +/- 1.10554*i
PicoLisp
(scl 40)
(de solveQuad (A B C)
(let SD (sqrt (- (* B B) (* 4 A C)))
(if (lt0 B)
(list
(*/ (- SD B) A 2.0)
(*/ C 2.0 (*/ A A (- SD B) `(* 1.0 1.0))) )
(list
(*/ C 2.0 (*/ A A (- 0 B SD) `(* 1.0 1.0)))
(*/ (- 0 B SD) A 2.0) ) ) ) )
(mapcar round
(solveQuad 1.0 -1000000.0 1.0)
(6 .) )
- Output:
-> ("999,999.999999" "0.000001")
PL/I
declare (c1, c2) float complex,
(a, b, c, x1, x2) float;
get list (a, b, c);
if b**2 < 4*a*c then
do;
c1 = (-b + sqrt(b**2 - 4+0i*a*c)) / (2*a);
c2 = (-b - sqrt(b**2 - 4+0i*a*c)) / (2*a);
put data (c1, c2);
end;
else
do;
x1 = (-b + sqrt(b**2 - 4*a*c)) / (2*a);
x2 = (-b - sqrt(b**2 - 4*a*c)) / (2*a);
put data (x1, x2);
end;
Python
This solution compares the naïve method with three "better" methods.
#!/usr/bin/env python3
import math
import cmath
import numpy
def quad_discriminating_roots(a,b,c, entier = 1e-5):
"""For reference, the naive algorithm which shows complete loss of
precision on the quadratic in question. (This function also returns a
characterization of the roots.)"""
discriminant = b*b - 4*a*c
a,b,c,d =complex(a), complex(b), complex(c), complex(discriminant)
root1 = (-b + cmath.sqrt(d))/2./a
root2 = (-b - cmath.sqrt(d))/2./a
if abs(discriminant) < entier:
return "real and equal", abs(root1), abs(root1)
if discriminant > 0:
return "real", root1.real, root2.real
return "complex", root1, root2
def middlebrook(a, b, c):
try:
q = math.sqrt(a*c)/b
f = .5+ math.sqrt(1-4*q*q)/2
except ValueError:
q = cmath.sqrt(a*c)/b
f = .5+ cmath.sqrt(1-4*q*q)/2
return (-b/a)*f, -c/(b*f)
def whatevery(a, b, c):
try:
d = math.sqrt(b*b-4*a*c)
except ValueError:
d = cmath.sqrt(b*b-4*a*c)
if b > 0:
return div(2*c, (-b-d)), div((-b-d), 2*a)
else:
return div((-b+d), 2*a), div(2*c, (-b+d))
def div(n, d):
"""Divide, with a useful interpretation of division by zero."""
try:
return n/d
except ZeroDivisionError:
if n:
return n*float('inf')
return float('nan')
testcases = [
(3, 4, 4/3), # real, equal
(3, 2, -1), # real, unequal
(3, 2, 1), # complex
(1, -1e9, 1), # ill-conditioned "quadratic in question" required by task.
(1, -1e100, 1),
(1, -1e200, 1),
(1, -1e300, 1),
]
print('Naive:')
for c in testcases:
print("{} {:.5} {:.5}".format(*quad_discriminating_roots(*c)))
print('\nMiddlebrook:')
for c in testcases:
print(("{:.5} "*2).format(*middlebrook(*c)))
print('\nWhat Every...')
for c in testcases:
print(("{:.5} "*2).format(*whatevery(*c)))
print('\nNumpy:')
for c in testcases:
print(("{:.5} "*2).format(*numpy.roots(c)))
- Output:
Naive: real and equal 0.66667 0.66667 real 0.33333 -1.0 complex (-0.33333+0.4714j) (-0.33333-0.4714j) real 1e+09 0.0 real 1e+100 0.0 real nan nan real nan nan Middlebrook: -0.66667 -0.66667 (-1+0j) (0.33333+0j) (-0.33333-0.4714j) (-0.33333+0.4714j) 1e+09 1e-09 1e+100 1e-100 1e+200 1e-200 1e+300 1e-300 What Every... -0.66667 -0.66667 0.33333 -1.0 (-0.33333+0.4714j) (-0.33333-0.4714j) 1e+09 1e-09 1e+100 1e-100 inf 0.0 inf 0.0 Numpy: -0.66667 -0.66667 -1.0 0.33333 (-0.33333+0.4714j) (-0.33333-0.4714j) 1e+09 1e-09 1e+100 1e-100 1e+200 1e-200 1e+300 0.0
R
qroots <- function(a, b, c) {
r <- sqrt(b * b - 4 * a * c + 0i)
if (abs(b - r) > abs(b + r)) {
z <- (-b + r) / (2 * a)
} else {
z <- (-b - r) / (2 * a)
}
c(z, c / (z * a))
}
qroots(1, 0, 2i)
[1] -1+1i 1-1i
qroots(1, -1e9, 1)
[1] 1e+09+0i 1e-09+0i
Using the builtin polyroot function (note the order of coefficients is reversed):
polyroot(c(2i, 0, 1))
[1] -1+1i 1-1i
polyroot(c(1, -1e9, 1))
[1] 1e-09+0i 1e+09+0i
Racket
#lang racket
(define (quadratic a b c)
(let* ((-b (- b))
(delta (- (expt b 2) (* 4 a c)))
(denominator (* 2 a)))
(list
(/ (+ -b (sqrt delta)) denominator)
(/ (- -b (sqrt delta)) denominator))))
;(quadratic 1 0.0000000000001 -1)
;'(0.99999999999995 -1.00000000000005)
;(quadratic 1 0.0000000000001 1)
;'(-5e-014+1.0i -5e-014-1.0i)
Raku
(formerly Perl 6)
Works with previous versions also but will return slightly less precise results.
Raku has complex number handling built in.
for
[1, 2, 1],
[1, 2, 3],
[1, -2, 1],
[1, 0, -4],
[1, -10⁶, 1]
-> @coefficients {
printf "Roots for %d, %d, %d\t=> (%s, %s)\n",
|@coefficients, |quadroots(@coefficients);
}
sub quadroots (*[$a, $b, $c]) {
( -$b + $_ ) / (2 × $a),
( -$b - $_ ) / (2 × $a)
given
($b² - 4 × $a × $c ).Complex.sqrt.narrow
}
- Output:
Roots for 1, 2, 1 => (-1, -1) Roots for 1, 2, 3 => (-1+1.4142135623730951i, -1-1.4142135623730951i) Roots for 1, -2, 1 => (1, 1) Roots for 1, 0, -4 => (2, -2) Roots for 1, -1000000, 1 => (999999.999999, 1.00000761449337e-06)
REXX
version 1
The REXX language doesn't have a sqrt function, nor does it support complex numbers natively.
Since "unlimited" decimal precision is part of the REXX language, the numeric digits was increased
(from a default of 9) to 200 to accommodate when a root is closer to zero than the other root.
Note that only nine decimal digits (precision) are shown in the displaying of the output.
This REXX version supports complex numbers for the result.
/*REXX program finds the roots (which may be complex) of a quadratic function. */
parse arg a b c . /*obtain the specified arguments: A B C*/
call quad a,b,c /*solve quadratic function via the sub.*/
r1= r1/1; r2= r2/1; a= a/1; b= b/1; c= c/1 /*normalize numbers to a new precision.*/
if r1j\=0 then r1=r1||left('+',r1j>0)(r1j/1)"i" /*Imaginary part? Handle complex number*/
if r2j\=0 then r2=r2||left('+',r2j>0)(r2j/1)"i" /* " " " " " */
say ' a =' a /*display the normalized value of A. */
say ' b =' b /* " " " " " B. */
say ' c =' c /* " " " " " C. */
say; say 'root1 =' r1 /* " " " " 1st root*/
say 'root2 =' r2 /* " " " " 2nd root*/
exit 0 /*stick a fork in it, we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
quad: parse arg aa,bb,cc; numeric digits 200 /*obtain 3 args; use enough dec. digits*/
$= sqrt(bb**2-4*aa*cc); L= length($) /*compute SQRT (which may be complex).*/
r= 1 /(aa+aa); ?= right($, 1)=='i' /*compute reciprocal of 2*aa; Complex?*/
if ? then do; r1= -bb *r; r2=r1; r1j= left($,L-1)*r; r2j=-r1j; end
else do; r1=(-bb+$)*r; r2=(-bb-$)*r; r1j= 0; r2j= 0; end
return
/*──────────────────────────────────────────────────────────────────────────────────────*/
sqrt: procedure; parse arg x 1 ox; if x=0 then return 0; d= digits(); m.= 9; numeric form
numeric digits 9; h= d+6; x=abs(x); parse value format(x,2,1,,0) 'E0' with g 'E' _ .
g=g*.5'e'_%2; do j=0 while h>9; m.j=h; h=h%2+1; end /*j*/
do k=j+5 to 0 by -1; numeric digits m.k; g=(g+x/g)*.5; end /*k*/
numeric digits d; return (g/1)left('i', ox<0) /*make complex if OX<0. */
- output when using the input of: 1 -10e5 1
a = 1 b = -1000000 c = 1 root1 = 1000000 root2 = 0.000001
The following output is when Regina 3.9.3 REXX is used.
- output when using the input of: 1 -10e9 1
a = 1 b = -1.0E+10 c = 1 root1 = 1.000000000E+10 root2 = 1E-10
The following output is when R4 REXX is used.
- output when using the input of: 1 -10e9 1
a = 1 b = -1E+10 c = 1 root1 = 1E+10 root2 = 0.0000000001
- output when using the input of: 3 2 1
a = 3 b = 2 c = 1 root1 = -0.333333333+0.471404521i root2 = -0.333333333-0.471404521i
{{out|output|text= when using the input of: 1 0 1
a = 1 b = 0 c = 1 root1 = 0+1i root2 = 0-1i
Version 2
/* REXX ***************************************************************
* 26.07.2913 Walter Pachl
**********************************************************************/
Numeric Digits 30
Parse Arg a b c 1 alist
Select
When a='' | a='?' Then
Call exit 'rexx qgl a b c solves a*x**2+b*x+c'
When words(alist)<>3 Then
Call exit 'three numbers are required'
Otherwise
Nop
End
gl=a'*x**2'
Select
When b<0 Then gl=gl||b'*x'
When b>0 Then gl=gl||'+'||b'*x'
Otherwise Nop
End
Select
When c<0 Then gl=gl||c
When c>0 Then gl=gl||'+'||c
Otherwise Nop
End
Say gl '= 0'
d=b**2-4*a*c
If d<0 Then Do
dd=sqrt(-d)
r=-b/(2*a)
i=dd/(2*a)
x1=r'+'i'i'
x2=r'-'i'i'
End
Else Do
dd=sqrt(d)
x1=(-b+dd)/(2*a)
x2=(-b-dd)/(2*a)
End
Say 'x1='||x1
Say 'x2='||x2
Exit
sqrt:
/* REXX ***************************************************************
* EXEC to calculate the square root of x with high precision
**********************************************************************/
Parse Arg x
prec=digits()
prec1=2*prec
eps=10**(-prec1)
k = 1
Numeric Digits prec1
r0= x
r = 1
Do i=1 By 1 Until r=r0 | (abs(r*r-x)<eps)
r0 = r
r = (r + x/r) / 2
k = min(prec1,2*k)
Numeric Digits (k + 5)
End
Numeric Digits prec
Return (r+0)
exit: Say arg(1)
Exit
- Output:
Version 1: a = 1 b = -1 c = 0 root1 = 1 root2 = 0 Version 2: 1*x**2-1.0000000001*x+1.e-9 = 0 x1=0.9999999991000000000025 x2=0.0000000009999999999975
Ring
x1 = 0
x2 = 0
quadratic(3, 4, 4/3.0) # [-2/3]
see "x1 = " + x1 + " x2 = " + x2 + nl
quadratic(3, 2, -1) # [1/3, -1]
see "x1 = " + x1 + " x2 = " + x2 + nl
quadratic(-2, 7, 15) # [-3/2, 5]
see "x1 = " + x1 + " x2 = " + x2 + nl
quadratic(1, -2, 1) # [1]
see "x1 = " + x1 + " x2 = " + x2 + nl
func quadratic a, b, c
sqrtDiscriminant = sqrt(pow(b,2) - 4*a*c)
x1 = (-b + sqrtDiscriminant) / (2.0*a)
x2 = (-b - sqrtDiscriminant) / (2.0*a)
return [x1, x2]
RPL
RPL can solve quadratic functions directly :
'x^2-1E9*x+1' 'x' QUAD
returns
1: '(1000000000+s1*1000000000)/2'
which can then be turned into roots by storing 1 or -1 in the s1
variable and evaluating the formula:
DUP 1 's1' STO EVAL SWAP -1 's1' STO EVAL
hence returning
2: 1000000000 1: 0
So let's implement the algorithm proposed by the task:
RPL code | Comment |
---|---|
≪ IF DUP TYPE 1 == THEN IF DUP IM NOT THEN RE END END ≫ 'REALZ' STO . ≪ → a b c ≪ IF b NOT THEN c a / NEG √ DUP NEG ELSE a c * √ b / 1 SWAP SQ 4 * - √ 2 / 0.5 + b * NEG DUP a / REALZ c ROT / REALZ END ≫ ≫ 'QROOT' STO |
REALZ ( number → number ) if number is a complex with no imaginary part, then turn it into a real QROOT ( a b c → r1 r2 ) if b=0 then roots are obvious, else q = sqrt(a*c)/b f = 1/2+sqrt(1-4*q^2)/2 get -b*f root1 = -b/a*f root2 = -c/(b*f) |
1 -1E9 1 QROOT
actually returns a more correct answer:
2: 1000000000 1: .000000001
Ruby
The CMath#sqrt method will return a Complex instance if necessary.
require 'cmath'
def quadratic(a, b, c)
sqrt_discriminant = CMath.sqrt(b**2 - 4*a*c)
[(-b + sqrt_discriminant) / (2.0*a), (-b - sqrt_discriminant) / (2.0*a)]
end
p quadratic(3, 4, 4/3.0) # [-2/3]
p quadratic(3, 2, -1) # [1/3, -1]
p quadratic(3, 2, 1) # [(-1/3 + sqrt(2/9)i), (-1/3 - sqrt(2/9)i)]
p quadratic(1, 0, 1) # [(0+i), (0-i)]
p quadratic(1, -1e6, 1) # [1e6, 1e-6]
p quadratic(-2, 7, 15) # [-3/2, 5]
p quadratic(1, -2, 1) # [1]
p quadratic(1, 3, 3) # [(-3 + sqrt(3)i)/2), (-3 - sqrt(3)i)/2)]
- Output:
[-0.6666666666666666, -0.6666666666666666] [0.3333333333333333, -1.0] [(-0.3333333333333333+0.47140452079103173i), (-0.3333333333333333-0.47140452079103173i)] [(0.0+1.0i), (0.0-1.0i)] [999999.999999, 1.00000761449337e-06] [-1.5, 5.0] [1.0, 1.0] [(-1.5+0.8660254037844386i), (-1.5-0.8660254037844386i)]
Run BASIC
print "FOR 1,2,3 => ";quad$(1,2,3)
print "FOR 4,5,6 => ";quad$(4,5,6)
FUNCTION quad$(a,b,c)
d = b^2-4 * a*c
x = -1*b
if d<0 then
quad$ = str$(x/(2*a));" +i";str$(sqr(abs(d))/(2*a))+" , "+str$(x/(2*a));" -i";str$(sqr(abs(d))/abs(2*a))
else
quad$ = str$(x/(2*a)+sqr(d)/(2*a))+" , "+str$(x/(2*a)-sqr(d)/(2*a))
end if
END FUNCTION
FOR 1,2,3 => -1 +i1.41421356 , -1 -i1.41421356 FOR 4,5,6 => -0.625 +i1.05326872 , -0.625 -i1.05326872
Scala
Using Complex class from task Arithmetic/Complex.
import ArithmeticComplex._
object QuadraticRoots {
def solve(a:Double, b:Double, c:Double)={
val d = b*b-4.0*a*c
val aa = a+a
if (d < 0.0) { // complex roots
val re= -b/aa;
val im = math.sqrt(-d)/aa;
(Complex(re, im), Complex(re, -im))
}
else { // real roots
val re=if (b < 0.0) (-b+math.sqrt(d))/aa else (-b -math.sqrt(d))/aa
(re, (c/(a*re)))
}
}
}
Usage:
val equations=Array(
(1.0, 22.0, -1323.0), // two distinct real roots
(6.0, -23.0, 20.0), // with a != 1.0
(1.0, -1.0e9, 1.0), // with one root near zero
(1.0, 2.0, 1.0), // one real root (double root)
(1.0, 0.0, 1.0), // two imaginary roots
(1.0, 1.0, 1.0) // two complex roots
);
equations.foreach{v =>
val (a,b,c)=v
println("a=%g b=%g c=%g".format(a,b,c))
val roots=solve(a, b, c)
println("x1="+roots._1)
if(roots._1 != roots._2) println("x2="+roots._2)
println
}
- Output:
a=1.00000 b=22.0000 c=-1323.00 x1=-49.0 x2=27.0 a=6.00000 b=-23.0000 c=20.0000 x1=2.5 x2=1.3333333333333333 a=1.00000 b=-1.00000e+09 c=1.00000 x1=1.0E9 x2=1.0E-9 a=1.00000 b=2.00000 c=1.00000 x1=-1.0 a=1.00000 b=0.00000 c=1.00000 x1=-0.0 + 1.0i x2=-0.0 + -1.0i a=1.00000 b=1.00000 c=1.00000 x1=-0.5 + 0.8660254037844386i x2=-0.5 + -0.8660254037844386i
Scheme
(define (quadratic a b c)
(if (= a 0)
(if (= b 0) 'fail (- (/ c b)))
(let ((delta (- (* b b) (* 4 a c))))
(if (and (real? delta) (> delta 0))
(let ((u (+ b (* (if (>= b 0) 1 -1) (sqrt delta)))))
(list (/ u -2 a) (/ (* -2 c) u)))
(list
(/ (- (sqrt delta) b) 2 a)
(/ (+ (sqrt delta) b) -2 a))))))
; examples
(quadratic 1 -1 -1)
; (1.618033988749895 -0.6180339887498948)
(quadratic 1 0 -2)
; (-1.4142135623730951 1.414213562373095)
(quadratic 1 0 2)
; (0+1.4142135623730951i 0-1.4142135623730951i)
(quadratic 1+1i 2 5)
; (-1.0922677260818898-1.1884256155834088i 0.09226772608188982+2.1884256155834088i)
(quadratic 0 4 3)
; -3/4
(quadratic 0 0 1)
; fail
(quadratic 1 2 0)
; (-2 0)
(quadratic 1 2 1)
; (-1 -1)
(quadratic 1 -1e5 1)
; (99999.99999 1.0000000001000001e-05)
Seed7
$ include "seed7_05.s7i";
include "float.s7i";
include "math.s7i";
const type: roots is new struct
var float: x1 is 0.0;
var float: x2 is 0.0;
end struct;
const func roots: solve (in float: a, in float: b, in float: c) is func
result
var roots: solution is roots.value;
local
var float: sd is 0.0;
var float: x is 0.0;
begin
sd := sqrt(b**2 - 4.0 * a * c);
if b < 0.0 then
x := (-b + sd) / 2.0 * a;
solution.x1 := x;
solution.x2 := c / (a * x);
else
x := (-b - sd) / 2.0 * a;
solution.x1 := c / (a * x);
solution.x2 := x;
end if;
end func;
const proc: main is func
local
var roots: r is roots.value;
begin
r := solve(1.0, -10.0E5, 1.0);
writeln("X1 = " <& r.x1 digits 6 <& " X2 = " <& r.x2 digits 6);
end func;
- Output:
X1 = 1000000.000000 X2 = 0.000001
Sidef
var sets = [
[1, 2, 1],
[1, 2, 3],
[1, -2, 1],
[1, 0, -4],
[1, -1e6, 1],
]
func quadroots(a, b, c) {
var root = sqrt(b**2 - 4*a*c)
[(-b + root) / (2 * a),
(-b - root) / (2 * a)]
}
sets.each { |coefficients|
say ("Roots for #{coefficients}",
"=> (#{quadroots(coefficients...).join(', ')})")
}
- Output:
Roots for [1, 2, 1]=> (-1, -1) Roots for [1, 2, 3]=> (-1+1.41421356237309504880168872420969807856967187538i, -1-1.41421356237309504880168872420969807856967187538i) Roots for [1, -2, 1]=> (1, 1) Roots for [1, 0, -4]=> (2, -2) Roots for [1, -1000000, 1]=> (999999.999998999999999998999999999997999999999995, 0.00000100000000000100000000000200000000000500000000002)
Stata
mata
: polyroots((-2,0,1))
1 2
+-----------------------------+
1 | 1.41421356 -1.41421356 |
+-----------------------------+
: polyroots((2,0,1))
1 2
+-------------------------------+
1 | -1.41421356i 1.41421356i |
+-------------------------------+
Tcl
package require math::complexnumbers
namespace import math::complexnumbers::complex math::complexnumbers::tostring
proc quadratic {a b c} {
set discrim [expr {$b**2 - 4*$a*$c}]
set roots [list]
if {$discrim < 0} {
set term1 [expr {(-1.0*$b)/(2*$a)}]
set term2 [expr {sqrt(abs($discrim))/(2*$a)}]
lappend roots [tostring [complex $term1 $term2]] \
[tostring [complex $term1 [expr {-1 * $term2}]]]
} elseif {$discrim == 0} {
lappend roots [expr {-1.0*$b / (2*$a)}]
} else {
lappend roots [expr {(-1*$b + sqrt($discrim)) / (2 * $a)}] \
[expr {(-1*$b - sqrt($discrim)) / (2 * $a)}]
}
return $roots
}
proc report_quad {a b c} {
puts [format "%sx**2 + %sx + %s = 0" $a $b $c]
foreach root [quadratic $a $b $c] {
puts " x = $root"
}
}
# examples on this page
report_quad 3 4 [expr {4/3.0}] ;# {-2/3}
report_quad 3 2 -1 ;# {1/3, -1}
report_quad 3 2 1 ;# {(-1/3 + sqrt(2/9)i), (-1/3 - sqrt(2/9)i)}
report_quad 1 0 1 ;# {(0+i), (0-i)}
report_quad 1 -1e6 1 ;# {1e6, 1e-6}
# examples from http://en.wikipedia.org/wiki/Quadratic_equation
report_quad -2 7 15 ;# {5, -3/2}
report_quad 1 -2 1 ;# {1}
report_quad 1 3 3 ;# {(-3 - sqrt(3)i)/2), (-3 + sqrt(3)i)/2)}
- Output:
3x**2 + 4x + 1.3333333333333333 = 0 x = -0.6666666666666666 3x**2 + 2x + -1 = 0 x = 0.3333333333333333 x = -1.0 3x**2 + 2x + 1 = 0 x = -0.3333333333333333+0.47140452079103173i x = -0.3333333333333333-0.47140452079103173i 1x**2 + 0x + 1 = 0 x = i x = -i 1x**2 + -1e6x + 1 = 0 x = 999999.999999 x = 1.00000761449337e-6 -2x**2 + 7x + 15 = 0 x = -1.5 x = 5.0 1x**2 + -2x + 1 = 0 x = 1.0 1x**2 + 3x + 3 = 0 x = -1.5+0.8660254037844386i x = -1.5-0.8660254037844386i
TI-89 BASIC
TI-89 BASIC has built-in numeric and algebraic solvers.
solve(x^2-1E9x+1.0)
returns
x=1.E-9 or x=1.E9
Wren
import "./complex" for Complex
var quadratic = Fn.new { |a, b, c|
var d = b*b - 4*a*c
if (d == 0) {
// single root
return [[-b/(2*a)], null]
}
if (d > 0) {
// two real roots
var sr = d.sqrt
d = (b < 0) ? sr - b : -sr - b
return [[d/(2*a), 2*c/d], null]
}
// two complex roots
var den = 1 / (2*a)
var t1 = Complex.new(-b*den, 0)
var t2 = Complex.new(0, (-d).sqrt * den)
return [[], [t1+t2, t1-t2]]
}
var test = Fn.new { |a, b, c|
System.write("coefficients: %(a), %(b), %(c) -> ")
var roots = quadratic.call(a, b, c)
var r = roots[0]
if (r.count == 1) {
System.print("one real root: %(r[0])")
} else if (r.count == 2) {
System.print("two real roots: %(r[0]) and %(r[1])")
} else {
var i = roots[1]
System.print("two complex roots: %(i[0]) and %(i[1])")
}
}
var coeffs = [
[1, -2, 1],
[1, 0, 1],
[1, -10, 1],
[1, -1000, 1],
[1, -1e9, 1]
]
for (c in coeffs) test.call(c[0], c[1], c[2])
- Output:
coefficients: 1, -2, 1 -> one real root: 1 coefficients: 1, 0, 1 -> two complex roots: 0 + i and 0 - i coefficients: 1, -10, 1 -> two real roots: 9.8989794855664 and 0.10102051443364 coefficients: 1, -1000, 1 -> two real roots: 999.998999999 and 0.001000001000002 coefficients: 1, -1000000000, 1 -> two real roots: 1000000000 and 1e-09
XPL0
include xpllib; \for Print
func real QuadRoots(A, B, C); \Return roots of quadratic equation
real A, B, C;
real D, E, R;
[R:= [0., 0., 0.];
R(0):= 0.; R(1):= 0.; R(2):= 0.;
D:= B*B - 4.*A*C;
case of
D = 0.: [R(0):= -B / (2.*A); \single root
R(1):= R(0);
];
D > 0.: [if B < 0. then \two real roots
E:= sqrt(D) - B
else E:= -sqrt(D) - B;
R(0):= E / (2.*A);
R(1):= 2. * C / E;
];
D < 0.: [R(0):= -B / (2.*A); \real
R(2):= sqrt(-D) /(2.*A); \imaginary
]
other []; \D overflowed or a coefficient was NaN
return R;
];
func Test(A, B, C);
real A, B, C;
real R;
[Print("coefficients: %g, %g, %g -> ", A, B, C);
R:= QuadRoots(A, B, C);
if R(2) # 0. then
Print("two complex roots: %g+%gi, %g-%gi\n", R(0), R(2), R(0), R(2))
else [if R(0) = R(1) then
Print("one real root: %g\n", R(0))
else Print("two real roots: %15.15g, %15.15g\n", R(0), R(1));
];
];
real C; int I;
[C:= [ [1., -2., 1.],
[1., 0., 1.],
[1., -10., 1.],
[1., -1000., 1.],
[1., -1e9, 1.],
[1., -4., 6.] ];
for I:= 0 to 5 do
Test(C(I,0), C(I,1), C(I,2));
]
- Output:
coefficients: 1, -2, 1 -> one real root: 1 coefficients: 1, 0, 1 -> two complex roots: 0+1i, 0-1i coefficients: 1, -10, 1 -> two real roots: 9.89897948556636, 0.101020514433644 coefficients: 1, -1000, 1 -> two real roots: 999.998999999, 0.001000001000002 coefficients: 1, -1e9, 1 -> two real roots: 1000000000, 0.000000001 coefficients: 1, -4, 6 -> two complex roots: 2+1.41421i, 2-1.41421i
zkl
zkl doesn't have a complex number package.
fcn quadratic(a,b,c){ b=b.toFloat();
println("Roots of a quadratic function %s, %s, %s".fmt(a,b,c));
d,a2:=(b*b - 4*a*c), a+a;
if(d>0){
sd:=d.sqrt();
println(" the real roots are %s and %s".fmt((-b + sd)/a2,(-b - sd)/a2));
}
else if(d==0) println(" the single root is ",-b/a2);
else{
sd:=(-d).sqrt();
println(" the complex roots are %s and \U00B1;%si".fmt(-b/a2,sd/a2));
}
}
foreach a,b,c in (T( T(1,-2,1), T(1,-3,2), T(1,0,1), T(1,-1.0e10,1), T(1,2,3), T(2,-1,-6)) ){
quadratic(a,b,c)
}
- Output:
Roots of a quadratic function 1, -2, 1 the single root is 1 Roots of a quadratic function 1, -3, 2 the real roots are 2 and 1 Roots of a quadratic function 1, 0, 1 the complex roots are 0 and ±1i Roots of a quadratic function 1, -1e+10, 1 the real roots are 1e+10 and 0 Roots of a quadratic function 1, 2, 3 the complex roots are -1 and ±1.41421i Roots of a quadratic function 2, -1, -6 the real roots are 2 and -1.5
- Programming Tasks
- Arithmetic operations
- Clarified and Needing Review
- 11l
- Ada
- ALGOL 68
- AutoHotkey
- BBC BASIC
- C
- C sharp
- C++
- Clojure
- Common Lisp
- D
- Delphi
- Elixir
- ERRE
- Factor
- Forth
- Fortran
- FreeBASIC
- GMP
- GAP
- Go
- Haskell
- Icon
- Unicon
- IDL
- IS-BASIC
- J
- Java
- Jq
- Julia
- K
- Kotlin
- Lambdatalk
- Liberty BASIC
- Logo
- Lua
- Maple
- Mathematica
- Wolfram Language
- MATLAB
- Octave
- Maxima
- МК-61/52
- Modula-3
- Nim
- OCaml
- PARI/GP
- Pascal
- Perl
- Phix
- PicoLisp
- PL/I
- Python
- NumPy
- R
- Racket
- Raku
- REXX
- Ring
- RPL
- Ruby
- Run BASIC
- Scala
- Scheme
- Seed7
- Sidef
- Stata
- Tcl
- Tcllib
- TI-89 BASIC
- Wren
- Wren-complex
- XPL0
- Zkl
- M4/Omit