Roots of a quadratic function: Difference between revisions

From Rosetta Code
Content added Content deleted
m (syntax highlighting fixup automation)
m (Undo revision 328301 by Thundergnat (talk) Wrong page contents)
Tag: Undo
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]]:
<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;</lang>
{{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: &nbsp; &nbsp; <big><big> ƒ(x) &nbsp; = &nbsp; 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
<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
V value = f(x)
(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(‘Root found near ’x)
print(r2)</lang>

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.Text_Io; use Ada.Text_Io;
<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
return (X**3 - 3.0*X*X + 2.0*X);
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;
Start : constant Long_Float := -1.0;
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;</lang>
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] - due to extensive use of FORMATted transput}}
{{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}}
<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 XY = STRUCT(DBL x, y);
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;


IF y1 = 0 THEN
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;
dy := y1 - y2;
printf(($"REAL x1 = "$, real fmt, r[1],
dx := dx / dy * y2;
$", 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
SKIP
([]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:
EMPTY
))
FI
ESAC
OD
);
END # quadratic_equation #</lang>
{{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:
<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"
x := x1, y := %f%(x), s := (y>0)-(y<0)
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) {
}</lang>
Return ((x-3)*x+2)*x
}</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"> function$ = "x^3-3*x^2+2*x"
<lang bbcbasic> FOR test% = 1 TO 7
rangemin = -1
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
accuracy = 1E-8
NEXT
PROCroots(function$, rangemin, rangemax, stepsize, accuracy)
END
END
DEF PROCroots(func$, min, max, inc, eps)
DATA 1, -1E9, 1
LOCAL x, sign%, oldsign%
DATA 1, 0, 1
oldsign% = 0
DATA 2, -1, -6
FOR x = min TO max STEP inc
DATA 1, 2, -2
sign% = SGN(EVAL(func$))
DATA 0.5, SQR(2), 1
IF sign% = 0 THEN
DATA 1, 3, 2
DATA 3, 4, 5
PRINT "Root found at x = "; x
sign% = -oldsign%
DEF PROCsolvequadratic(a, b, c)
ELSE IF sign% <> oldsign% AND oldsign% <> 0 THEN
IF inc < eps THEN
LOCAL d, f
d = b^2 - 4*a*c
PRINT "Root found near x = "; x
ELSE
CASE SGN(d) OF
WHEN 0:
PROCroots(func$, x-inc, x+inc/8, inc/8, eps)
ENDIF
PRINT "the single root is " ; -b/2/a
ENDIF
WHEN +1:
ENDIF
f = (1 + SQR(1-4*a*c/b^2))/2
PRINT "the real roots are " ; -f*b/a " and " ; -c/b/f
oldsign% = sign%
NEXT x
WHEN -1:
PRINT "the complex roots are " ; -b/2/a " +/- " ; SQR(-d)/2/a "*i"
ENDPROC</syntaxhighlight>
ENDCASE
Output:
ENDPROC</lang>
<pre>Root found near x = 2.29204307E-9
{{out}}
Root found near x = 1
<pre>For a = 1, b = -1E9, c = 1 the real roots are 1E9 and 1E-9
Root found at x = 2</pre>
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</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)
<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)) {
{
double e = 1.0e-12;
e = 1 - (a / b) * (c / b);
d = sqrt(fabs(e)) * fabs(b);
double fA, fB;
} else {
double d;
int i;
e = (c > 0) ? a : -a;
int limit = 50;
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);
d = (xB - xA) / (fB - fA) * fB;
*ra = d + I * e;
if (fabs(d) < e)
*rb = d - I * e;
return;
break;
}
xA = xB;

fA = fB;
xB -= d;
d = (b >= 0) ? d : -d;
}
e = (d - b) / a;
if (i==limit) {
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 argc, char *argv[])
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) {
}</lang>
value = f(x);
{{out}}<pre>(-1e+12 + 0 i), (-1 + 0 i)
if (fabs(value) < e) {
(1.00208e+07 + 0 i), (9.9792e-08 + 0 i)</pre>
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>


<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);

for(int i = 0; i < 3; ++i)
printf("%.12f\n", z[2 * i]);

return 0;
}</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#}}==


delta = b*b - 4.0*a*c;
x[0] = (-b + csqrt(delta)) / (2.0*a);
x[1] = (-b - csqrt(delta)) / (2.0*a);
}</lang>
{{trans|C++}}
{{trans|C++}}
<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;
Func<double, double> f = x => { return x * x * x - 3 * x * x + 2 * x; };
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;
}
}</lang>


<lang c>int main()
double step = 0.001; // Smaller step values produce more accurate and precise results
double start = -1;
double stop = 3;
double value = f(start);
int sign = (value > 0) ? 1 : 0;
// 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>

{{trans|Java}}
<syntaxhighlight lang="csharp">using System;

class Program
{
{
private static int Sign(double x)
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)
}</lang>
{
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===
<lang csharp>using System;

using System.Numerics;
{{trans|C++}}
<syntaxhighlight lang="csharp">using System;


class Program
class QuadraticRoots
{
{
static Tuple<Complex, Complex> Solve(double a, double b, double c)
public static void Main(string[] args)
{
{
Func<double, double> f = x => { return x * x * x - 3 * x * x + 2 * x; };
var q = -(b + Math.Sign(b) * Complex.Sqrt(b * b - 4 * a * c)) / 2;
double root = BrentsFun(f, lower: -1.0, upper: 4, tol: 0.002, maxIter: 100);
return Tuple.Create(q / a, c / q);
}
}


private static void Swap<T>(ref T a, ref T b)
static void Main()
{
{
var tmp = a;
Console.WriteLine(Solve(1, -1E20, 1));
a = b;
b = tmp;
}
}
}</lang>
{{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)
<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
bool mflag = true; // boolean flag used to evaluate if statement later on
: (-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;
}</lang>
double stop = 3;
{{out}}
double value = f(start);
(1e+20,0), (1e-20,0)
double sign = (value > 0);
// Check for root at start
if ( 0 == value )
std::cout << "Root found at " << start << std::endl;


=={{header|Clojure}}==
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>


<lang clojure>(defn quadratic
===Brent's Method===
"Compute the roots of a quadratic in the form ax^2 + bx + c = 1.
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.
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</lang>


{{out}}
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).
<lang clojure>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]
</lang>


=={{header|Common Lisp}}==
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.
<lang lisp>(defun quadratic (a b c)
<syntaxhighlight lang="cpp">#include <iostream>
(list
#include <cmath>
(/ (+ (- b) (sqrt (- (expt b 2) (* 4 a c)))) (* 2 a))
#include <algorithm>
(/ (- (- b) (sqrt (- (expt b 2) (* 4 a c)))) (* 2 a))))</lang>
#include <functional>


=={{header|D}}==
double brents_fun(std::function<double (double)> f, double lower, double upper, double tol, unsigned int max_iter)
<lang d>import std.math, std.traits;
{
double a = lower;
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 = 0; // initialize


CommonType!(T1, T2, T3)[] naiveQR(T1, T2, T3)
if (!(fa * fb < 0))
(in T1 a, in T2 b, in T3 c)
{
pure nothrow if (isFloatingPoint!T1) {
std::cout << "Signs of f(lower_bound) and f(upper_bound) must be opposites" << std::endl; // throws exception if root isn't bracketed
alias ReturnT = typeof(typeof(return).init[0]);
return -11;
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)
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);


if (b * a < 0) {
double c = a; // c now equals the largest magnitude of the lower and upper bounds
immutable x = (-b + SD) / 2 * a;
double fc = fa; // precompute function evalutation for point c by assigning it the same value as fa
return [x, c / (a * x)];
bool mflag = true; // boolean flag used to evaluate if statement later on
} else {
double s = 0; // Our Root that will be returned
immutable x = (-b - SD) / 2 * a;
double d = 0; // Only used if mflag is unset (mflag == false)
return [c / (a * x), x];
}
}


void main() {
for (unsigned int iter = 1; iter < max_iter; ++iter)
import std.stdio;
{
writeln("With 32 bit float type:");
// stop if converged on root or error is less than tolerance
writefln(" Naive: [%(%g, %)]", naiveQR(1.0f, -10e5f, 1.0f));
if (std::abs(b-a) < tol)
writefln("Cautious: [%(%g, %)]", cautiQR(1.0f, -10e5f, 1.0f));
{
writeln("\nWith 64 bit double type:");
std::cout << "After " << iter << " iterations the root is: " << s << std::endl;
writefln(" Naive: [%(%g, %)]", naiveQR(1.0, -10e5, 1.0));
return s;
writefln("Cautious: [%(%g, %)]", cautiQR(1.0, -10e5, 1.0));
} // end if
writeln("\nWith real type:");
writefln(" Naive: [%(%g, %)]", naiveQR(1.0L, -10e5L, 1.0L));
if (fa != fc && fb != fc)
writefln("Cautious: [%(%g, %)]", cautiQR(1.0L, -10e5L, 1.0L));
{
}</lang>
// use inverse quadratic interopolation
{{out}}
s = ( a * fb * fc / ((fa - fb) * (fa - fc)) )
<pre>With 32 bit float type:
+ ( b * fa * fc / ((fb - fa) * (fb - fc)) )
Naive: [1e+06, 0]
+ ( c * fa * fb / ((fc - fa) * (fc - fb)) );
Cautious: [1e+06, 1e-06]
}
else
{
// secant method
s = b - fb * (b - a) / (fb - fa);
}


With 64 bit double type:
// checks to see whether we can use the faster converging quadratic && secant methods or if we need to use bisection
Naive: [1e+06, 1.00001e-06]
if ( ( (s < (3 * a + b) * 0.25) || (s > b) ) ||
Cautious: [1e+06, 1e-06]
( mflag && (std::abs(s-b) >= (std::abs(b-c) * 0.5)) ) ||
( !mflag && (std::abs(s-b) >= (std::abs(c-d) * 0.5)) ) ||
( mflag && (std::abs(b-c) < tol) ) ||
( !mflag && (std::abs(c-d) < tol)) )
{
// bisection method
s = (a+b)*0.5;


With real type:
mflag = true;
Naive: [1e+06, 1e-06]
}
Cautious: [1e+06, 1e-06]</pre>
else
{
mflag = false;
}


=={{header|Delphi}}==
fs = f(s); // calculate fs
See [https://rosettacode.org/wiki/Roots_of_a_quadratic_function#Pascal Pascal].
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)


=={{header|Elixir}}==
if ( fa * fs < 0) // fa and fs have opposite signs
<lang elixir>defmodule Quadratic do
{
def roots(a, b, c) do
b = s;
IO.puts "Roots of a quadratic function (#{a}, #{b}, #{c})"
fb = fs; // set f(b) = f(s)
d = b * b - 4 * a * c
}
a2 = a * 2
else
cond do
{
d > 0 ->
a = s;
fa = fs; // set f(a) = f(s)
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)
if (std::abs(fa) < std::abs(fb)) // if magnitude of fa is less than magnitude of fb
Quadratic.roots(1, -3, 2)
{
Quadratic.roots(1, 0, 1)
std::swap(a,b); // swap a and b
Quadratic.roots(1, -1.0e10, 1)
std::swap(fa,fb); // make sure f(a) and f(b) are correct after swap
Quadratic.roots(1, 2, 3)
}
Quadratic.roots(2, -1, -6)</lang>

} // end for

std::cout<< "The solution does not converge or iterations are not sufficient" << std::endl;

} // end brents_fun

</syntaxhighlight>

=={{header|Clojure}}==

{{trans|Haskell}}
<syntaxhighlight lang="clojure">

(defn findRoots [f start stop step eps]
(filter #(-> (f %) Math/abs (< eps)) (range start stop step)))
</syntaxhighlight>


{{out}}
<pre>
<pre>
Roots of a quadratic function (1, -2, 1)
> (findRoots #(+ (* % % %) (* -3 % %) (* 2 %)) -1.0 3.0 0.0001 0.00000001)
the single root is 1.0
(-9.381755897326649E-14 0.9999999999998124 1.9999999999997022)
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>
</pre>


=={{header|CoffeeScript}}==
=={{header|ERRE}}==
<lang>PROGRAM QUADRATIC
{{trans|Python}}
<syntaxhighlight lang="coffeescript">
print_roots = (f, begin, end, step) ->
# Print approximate roots of f between x=begin and x=end,
# using sign changes as an indicator that a root has been
# encountered.
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


PROCEDURE SOLVE_QUADRATIC
do ->
D=B*B-4*A*C
# Smaller steps produce more accurate/precise results in general,
IF ABS(D)<1D-6 THEN D=0 END IF
# but for many functions we'll never get exact roots, either due
CASE SGN(D) OF
# to imperfect binary representation or irrational roots.
step = 1 / 256
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
f1 = (x) -> x*x*x - 3*x*x + 2*x
PRINT(CHR$(12);) ! CLS
print_roots f1, -1, 5, step
f2 = (x) -> x*x - 4*x + 3
FOR TEST%=1 TO 7 DO
READ(A,B,C)
print_roots f2, -1, 5, step
PRINT("For a=";A;",b=";B;",c=";C;TAB(32);)
f3 = (x) -> x - 1.5
SOLVE_QUADRATIC
print_roots f3, 0, 4, step
END FOR
f4 = (x) -> x*x - 2
DATA(1,-1E9,1)
print_roots f4, -2, 2, step
DATA(1,0,1)
</syntaxhighlight>
DATA(2,-1,-6)
DATA(1,2,-2)
DATA(0.5,1.4142135,1)
DATA(1,3,2)
DATA(3,4,5)
END PROGRAM</lang>
{{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>


=={{header|Factor}}==
output
{{trans|Ada}}
<lang 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 * / ;</lang>


<lang factor>( scratchpad ) 1 -1.e20 1 quadratic-equation
<syntaxhighlight lang="text">
--- Data stack:
> coffee roots.coffee
1.0e+20
-----
9.999999999999999e-21</lang>
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>


Middlebrook method
=={{header|Common Lisp}}==
<lang factor>:: 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 / ;
</lang>


{{trans|Perl}}


<lang factor>( scratchpad ) 1 -1.e20 1 quadratic-equation
<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.
--- Data stack:
1.0e+20
1.0e-20</lang>


=={{header|Forth}}==
<syntaxhighlight lang="lisp">(defun find-roots (function start end &optional (step 0.0001))
Without locals:
(let* ((roots '())
<lang forth>: quadratic ( fa fb fc -- r1 r2 )
(value (funcall function start))
frot frot
(plusp (plusp value)))
(when (zerop value)
( c a b )
fover 3 fpick f* -4e f* fover fdup f* f+
(format t "~&Root found at ~W." start))
(do ((x (+ start step) (+ x step)))
( c a b det )
fdup f0< if abort" imaginary roots" then
((> x end) (nreverse roots))
fsqrt
(setf value (funcall function x))
(cond
fover f0< if fnegate then
f+ fnegate
((zerop value)
( c a b-det )
(format t "~&Root found at ~w." x)
(push x roots))
2e f/ fover f/
((not (eql plusp (plusp value)))
( c a r1 )
frot frot f/ fover f/ ;</lang>
(format t "~&Root found near ~w." x)
With locals:
(push (cons (- x step) x) roots)))
<lang forth>: quadratic { F: a F: b F: c -- r1 r2 }
(setf plusp (plusp value)))))</syntaxhighlight>
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
<pre>> (find-roots #'(lambda (x) (+ (* x x x) (* -3 x x) (* 2 x))) -1 3)
1 set-precision
Root found near 5.3588345E-5.
1e -1e6 1e quadratic fs. fs. \ 1e-6 1e6</lang>
Root found near 1.0000072.
Root found near 2.000073.
((-4.6411653E-5 . 5.3588345E-5)
(0.99990714 . 1.0000072)
(1.9999729 . 2.000073))</pre>


=={{header|D}}==
=={{header|Fortran}}==
===Fortran 90===
<syntaxhighlight lang="d">import std.stdio, std.math, std.algorithm;
{{works with|Fortran|90 and later}}
<lang fortran>PROGRAM QUADRATIC


IMPLICIT NONE
bool nearZero(T)(in T a, in T b = T.epsilon * 4) pure nothrow {
INTEGER, PARAMETER :: dp = SELECTED_REAL_KIND(15)
return abs(a) <= b;
REAL(dp) :: a, b, c, e, discriminant, rroot1, rroot2
}
COMPLEX(dp) :: croot1, croot2


WRITE(*,*) "Enter the coefficients of the equation ax^2 + bx + c"
T[] findRoot(T)(immutable T function(in T) pure nothrow fi,
WRITE(*, "(A)", ADVANCE="NO") "a = "
in T start, in T end, in T step=T(0.001L),
READ *, a
T tolerance = T(1e-4L)) {
WRITE(*,"(A)", ADVANCE="NO") "b = "
if (step.nearZero)
READ *, b
writefln("WARNING: step size may be too small.");
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</lang>
{{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===
/// Search root by simple bisection.
Source code written in FORTRAN I (october 1956) for the IBM 704.
T searchRoot(T a, T b) pure nothrow {
<lang fortran>
T root;
COMPUTE ROOTS OF A QUADRATIC FUNCTION - 1956
int limit = 49;
T gap = b - a;
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
</lang>


=={{header|FreeBASIC}}==
while (!nearZero(gap) && limit--) {
{{libheader|GMP}}
if (fi(a).nearZero)
<lang freebasic>' version 20-12-2020
return a;
' compile with: fbc -s console
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;
}


#Include Once "gmp.bi"
return root;
}


Sub solvequadratic_n(a As Double ,b As Double, c As Double)
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);
}


Dim As Double f, d = b ^ 2 - 4 * a * c
return result.keys.sort().release;
}


Select Case Sgn(d)
void report(T)(in T[] r, immutable T function(in T) pure f,
Case 0
in T tolerance = T(1e-4L)) {
Print "1: the single root is "; -b / 2 / a
if (r.length) {
Case 1
writefln("Root found (tolerance = %1.4g):", tolerance);
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
foreach (const x; r) {
immutable T y = f(x);


Sub solvequadratic_c(a As Double ,b As Double, c As Double)
if (nearZero(y))
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 Double f, d = b ^ 2 - 4 * a * c
void main() {
Select Case Sgn(d)
static real f(in real x) pure nothrow {
Case 0
return x ^^ 3 - (3 * x ^^ 2) + 2 * x;
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)
findRoot(&f, -1.0L, 3.0L, 0.001L).report(&f);
}</syntaxhighlight>
{{out}}
<pre>Root found (tolerance = 0.0001):
.... MAY-BE at -0.00000000000000000080, f(x) = -1.603e-18
... 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.


#Define PRECISION 1024 ' about 300 digits
=={{header|Dart}}==
#Define MAX 25
{{trans|Scala}}
<syntaxhighlight lang="dart">double fn(double x) => x * x * x - 3 * x * x + 2 * x;


Dim As ZString Ptr text
findRoots(Function(double) f, double start, double stop, double step, double epsilon) sync* {
text = Callocate (1000)
for (double x = start; x < stop; x = x + step) {
Mpf_set_default_prec(PRECISION)
if (fn(x).abs() < epsilon) yield x;
}
}


Dim As Mpf_ptr a, b, c, d, t
main() {
a = Allocate(Len(__mpf_struct)) : Mpf_init_set_d(a, a_)
// Vector(-9.381755897326649E-14, 0.9999999999998124, 1.9999999999997022)
b = Allocate(Len(__mpf_struct)) : Mpf_init_set_d(b, b_)
print(findRoots(fn, -1.0, 3.0, 0.0001, 0.000000001));
c = Allocate(Len(__mpf_struct)) : Mpf_init_set_d(c, c_)
}</syntaxhighlight>
d = Allocate(Len(__mpf_struct)) : Mpf_init(d)
t = Allocate(Len(__mpf_struct)) : Mpf_init(t)


mpf_mul(d, b, b)
=={{header|Delphi}}==
mpf_set_ui(t, 4)
See [https://rosettacode.org/wiki/Roots_of_a_function#Pascal Pascal].
mpf_mul(t, t, a)
mpf_mul(t, t, c)
mpf_sub(d, d, t)


Select Case mpf_sgn(d)
=={{header|DWScript}}==
Case 0
{{trans|C}}
mpf_neg(t, b)
<syntaxhighlight lang="delphi">type TFunc = function (x : Float) : Float;
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
function f(x : Float) : Float;
begin
Result := x*x*x-3.0*x*x +2.0*x;
end;


' ------=< MAIN >=------
const e = 1.0e-12;


Dim As Double a, b, c
function Secant(xA, xB : Float; f : TFunc) : Float;
Print "1: is the naieve way"
const
Print "2: is the cautious way"
limit = 50;
Print "3: is the naieve way with help of GMP"
var
Print
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;


For i As Integer = 1 To 10
const fstep = 1.0e-2;
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
var x := -1.032; // just so we use secant method
While Inkey <> "" : Wend
var xx, value : Float;
Print : Print "hit any key to end program"
var s := f(x)>0.0;
Sleep

End
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</lang>
{{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|Fortran}}==
=={{header|GAP}}==
<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 ]</lang>
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}}==
<lang go>package main
Secant method. No error checking.
<syntaxhighlight lang="go">package main


import (
import (
"fmt"
"fmt"
"math"
"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 findroots(f func(float64) float64, lower, upper, step float64) {
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.Printf(" %6.3f %s\n", r, status)
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) {
var f0 float64
for _, c := range [][3]float64{
{1, -2, 1},
f1 := f(x0)
for i := 0; i < 100; i++ {
{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"
}</lang>
}
{{out}}
x0, x1 = x1, x1-f1*(x1-x0)/(f1-f0)
}
return 0, ""
}</syntaxhighlight>
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">f x = x^3-3*x^2+2*x
<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>
]</lang>
{{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
<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) =>
(a -> a) -> [a] -> а (Root 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</lang>
findRoots f (a:b:xs) = bisection f a b <|> findRoots f (b:xs)</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`
<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</lang>
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|Icon}} and {{header|Unicon}}==
=={{header|IS-BASIC}}==
<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</lang>


=={{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


<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</lang>


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:
<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</lang>
->
</pre>


Exploring the limits of precision:
=={{header|J}}==


<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</lang>


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:


<lang j>q_r=: verb define
<syntaxhighlight lang="j"> (0=]p.1{::p.) 0 2 _3 1
'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</lang>


=={{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.
<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
0=blackbox 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 int sign(double x) {
private static Complex[] quadraticRoots(double a, double b, double c) {
return (x < 0.0) ? -1 : (x > 0.0) ? 1 : 0;
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 upperBound, double step) {
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 cx = x - dx * (y / dy);
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);
}
ox = x; oy = y; os = s;
}
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>
}</lang>
{{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.
<lang jq># Complex numbers as points [x,y] in the Cartesian plane
<syntaxhighlight lang="jq">def sign:
if . < 0 then -1 elif . > 0 then 1 else 0 end;
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):
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 ;</lang></div>
'''Section 2:''' quadratic_roots(a;b;c)
<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
;</lang>
'''Section 3''':
Produce a table showing [i, error, solution] for solutions to x^2 - 10^i + 1 = 0
<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
<pre>[0.0,1.0,2.0]</pre>
| (- (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</lang>
{{Out}} (scrolling window)
<div style="overflow:scroll; height:200px;">
<lang sh>
$ 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]</lang></div>


=={{header|Julia}}==
Without the Roots package, Newton's method may be defined in this manner:
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.
<syntaxhighlight lang="julia">function newton(f, fp, x::Float64,tol=1e-14::Float64,maxsteps=100::Int64)

##f: the function of x
Alternative solutions might make use of Julia's Polynomials or Roots packages.
##fp: the derivative of f

<lang julia>using Printf
local xnew, xold = x, Inf

local fn, fo = f(xnew), Inf
function quadroots(x::Real, y::Real, z::Real)
local counter = 1
a, b, c = promote(float(x), y, z)
if a ≈ 0.0 return [-c / b] end
while (counter < maxsteps) && (abs(xnew - xold) > tol) && ( abs(fn - fo) > tol )
x = xnew - f(xnew)/fp(xnew) ## update x
Δ = b ^ 2 - 4a * c
if Δ ≈ 0.0 return [-sqrt(c / a)] end
xnew, xold = x, xnew
fn, fo = f(xnew), fn
if Δ < 0.0 Δ = complex(Δ) end
counter += 1
d = sqrt(Δ)
if b < 0.0
end
d -= b
return [d / 2a, 2c / d]
if counter >= maxsteps
else
error("Did not converge in ", string(maxsteps), " steps")
else
d = -d - b
return [2c / d, d / 2a]
xnew, counter
end
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</lang>
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)
(1.0,2)
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|Kotlin}}==
=={{header|Kotlin}}==
{{trans|C}}
{{trans|Java}}
<syntaxhighlight lang="scala">// version 1.1.2
<lang scala>import java.lang.Math.*


typealias DoubleToDouble = (Double) -> Double
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 e = 1.0e-12
val _2a = a + a
val d = b * b - 4.0 * a * c // discriminant
val limit = 50
var xa = x1
if (d < 0.0) {
var xb = x2
val r = -b / _2a
var fa = f(xa)
val i = sqrt(-d) / _2a
Solution(Complex(r, i), Complex(r, -i))
var i = 0
while (i++ < limit) {
} else {
// avoid calculating -b +/- sqrt(d), to avoid any
var fb = f(xb)
val d = (xb - xa) / (fb - fa) * fb
// subtractive cancellation when it is near zero.
if (Math.abs(d) < e) break
val r = if (b < 0.0) (-b + sqrt(d)) / _2a else (-b - sqrt(d)) / _2a
xa = xb
Solution(r, c / (a * r))
fa = fb
}
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) {
println("Root found at x = ${"%12.9f".format(x)}")
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>


equations.forEach { println("$it\n" + it.quadraticRoots) }
}</lang>
{{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|Lambdatalk}}==
=={{header|lambdatalk}}==
<syntaxhighlight lang="scheme">
<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:
{S.map {lambda {:x}
{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}}
{S.serie -1 3 0.01}}
{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}}
{S.serie -720 +720 10}}
{let { {:a' {* 2 :a}}
{:b' {/ {- :b} {* 2 :a}}}
->
- a root found at -720°
{:d {- {* :b :b} {* 4 :a :c}}} }
{if {> :d 0}
- a root found at -540°
then {let { {:b' :b'}
- a root found at -360°
- a root found at -180°
{:d' {/ {sqrt :d} :a'}} }
- a root found at 0°
{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°
- a root found at 540°
{: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'.
LastY =y
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
x2 = 1
</lang>


=={{header|Liberty BASIC}}==
bigH=0.01
<lang lb>a=1:b=2:c=3
'assume a<>0
print quad$(a,b,c)
end


function quad$(a,b,c)
print
D=b^2-4*a*c
print " Checking for roots of x^3 -3 *x^2 +2 *x =0 over range -1 to +3"
print
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))
x=xMin: dx = bigH
do
else
quad$=str$(x/(2*a)+sqr(D)/(2*a));" , ";str$(x/(2*a)-sqr(D)/(2*a))
x=x+dx
y = f(x)
end if
end function</lang>
'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."

end


=={{header|Logo}}==
function f( x)
<lang logo>to quadratic :a :b :c
f =x^3 -3 *x^2 +2 *x
localmake "d sqrt (:b*:b - 4*:a*:c)
end function</syntaxhighlight>
if :b < 0 [make "d minus :d]
output list (:d-:b)/(2*:a) (2*:c)/(:d-:b)
end</lang>


=={{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


<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("Root (to 12DP)\tMax. Error\n")
print(qsolve(1, 0-10^i, 1))
end</lang>
for _, r in pairs(root(f, -1, 3, 10^-6)) do
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.
print(string.format("%0.12f", r.val), r.err)
end</syntaxhighlight>
{{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}}==
<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);</lang>
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):
<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}]</lang>
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);
<lang Matlab>roots([1 -3 2]) % coefficients in decreasing order of power e.g. [x^n ... x^2 x^1 x^0]</lang>
[x=-1, x=1]


=={{header|Maxima}}==
multiplicities;
<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] */</lang>


=={{header|МК-61/52}}==
/* Numerical root using Brent's method (here with another equation) */
<lang>П2 С/П /-/ <-> / 2 / П3 x^2 С/П
ИП2 / - Вx <-> КвКор НОП x>=0 28 ИП3
x<0 24 <-> /-/ + / Вx С/П /-/ КвКор
ИП3 С/П</lang>


''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
<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.</lang>
x=-6.82327803828019327369483739711048256891188581897998577803729b-1]</syntaxhighlight>


=={{header|Nim}}==
=={{header|Nim}}==
<syntaxhighlight lang="nim">import math
<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
let y = x +. step in
(1.0, -1000.0, 1.0),
let fy = f y in
(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}"</lang>
List.iter showroot (search (-5.0) 5.0 0.1 f);;</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.


<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)
printf(" not");
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:
;;</lang>

{{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}}
<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)</lang>
<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). -->
<lang parigp>roots(a,b,c)=polrootsreal(Pol([a,b,c]))</lang>
<syntaxhighlight lang="parigp">polroots(x^3-3*x^2+2*x)</syntaxhighlight>


{{trans|C}}
===Newton's method===
Otherwise, coding directly:
This uses a modified version of the Newton–Raphson method.
<lang parigp>roots(a,b,c)={
<syntaxhighlight lang="parigp">polroots(x^3-3*x^2+2*x,1)</syntaxhighlight>
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)")
)
)
)
)
)
};
};</lang>
findRoots(x^3-3*x^2+2*x)</syntaxhighlight>


Either way,
===Factorization to quadratic factors===
<lang parigp>roots(1,-1e9,1)</lang>
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 RootsFunction;
<lang pascal>Program QuadraticRoots;


var
var
e, x, step, value: double;
a, b, c, q, f: double;
s: boolean;
begin
i, limit: integer;
x1, x2, d: double;
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
x := -1;
q := sqrt(b * b - 4 * a * c);
step := 1.0e-6;
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
value := f(x);
f := (-b + q) / 2 * a;
writeln ('x1: ', f:16, ', x2: ', (c / (a * f)):16);
if abs(value) < e then
begin
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
if i > limit then
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.
</lang>
</syntaxhighlight>
{{out}}
Output:
<pre>
<pre>
Version 1: simply stepping x:
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
<lang perl>use Math::Complex;
{
my $x = shift;

return ($x * $x * $x - 3*$x*$x + 2*$x);
}

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;


($x1,$x2) = solveQuad(1,2,3);
# Check for root at start


print "Root found at $start\n" if ( 0 == $value );
print "x1 = $x1, x2 = $x2\n";


sub solveQuad
for( my $x = $start + $step;
$x <= $stop;
$x += $step )
{
{
my ($a,$b,$c) = @_;
$value = &f($x);
my $root = sqrt($b**2 - 4*$a*$c);

if ( 0 == $value )
return ( -$b + $root )/(2*$a), ( -$b - $root )/(2*$a);
}</lang>
{
# 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>


=={{header|Phix}}==
=={{header|Phix}}==
{{trans|CoffeeScript}}
{{trans|ERRE}}
<!--<syntaxhighlight lang="phix">(phixonline)-->
<!--<lang Phix>-->
<span style="color: #008080;">procedure</span> <span style="color: #000000;">print_roots</span><span style="color: #0000FF;">(</span><span style="color: #004080;">integer</span> <span style="color: #000000;">f</span><span style="color: #0000FF;">,</span> <span style="color: #004080;">atom</span> <span style="color: #000000;">start</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">stop</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">step</span><span style="color: #0000FF;">)</span>
<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: #004080;">atom</span> <span style="color: #000000;">x</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">start</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">y</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">0</span>
<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: #7060A8;">puts</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"-----\n"</span><span style="color: #0000FF;">)</span>
<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;">while</span> <span style="color: #000000;">x</span><span style="color: #0000FF;"><=</span><span style="color: #000000;">stop</span> <span style="color: #008080;">do</span>
<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: #004080;">atom</span> <span style="color: #000000;">last_y</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">y</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: #000000;">y</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">f</span><span style="color: #0000FF;">(</span><span style="color: #000000;">x</span><span style="color: #0000FF;">)</span>
<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: #008080;">or</span> <span style="color: #0000FF;">(</span><span style="color: #000000;">last_y</span><span style="color: #0000FF;"><</span><span style="color: #000000;">0</span> <span style="color: #008080;">and</span> <span style="color: #000000;">y</span><span style="color: #0000FF;">></span><span style="color: #000000;">0</span><span style="color: #0000FF;">)</span>
<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;">or</span> <span style="color: #0000FF;">(</span><span style="color: #000000;">last_y</span><span style="color: #0000FF;">></span><span style="color: #000000;">0</span> <span style="color: #008080;">and</span> <span style="color: #000000;">y</span><span style="color: #0000FF;"><</span><span style="color: #000000;">0</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">then</span>
<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: #7060A8;">printf</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"Root found %s %.10g\n"</span><span style="color: #0000FF;">,</span> <span style="color: #0000FF;">{</span><span style="color: #008080;">iff</span><span style="color: #0000FF;">(</span><span style="color: #000000;">y</span><span style="color: #0000FF;">=</span><span style="color: #000000;">0</span><span style="color: #0000FF;">?</span><span style="color: #008000;">"at"</span><span style="color: #0000FF;">:</span><span style="color: #008000;">"near"</span><span style="color: #0000FF;">),</span><span style="color: #000000;">x</span><span style="color: #0000FF;">})</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;">if</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">switch</span>
<span style="color: #000000;">x</span> <span style="color: #0000FF;">+=</span> <span style="color: #000000;">step</span>
<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: #008080;">constant</span> <span style="color: #000000;">step</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">1</span><span style="color: #0000FF;">/</span><span style="color: #000000;">256</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: #008080;">function</span> <span style="color: #000000;">f1</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;">x</span><span style="color: #0000FF;">-</span><span style="color: #000000;">3</span><span style="color: #0000FF;">*</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: #0000FF;">*</span><span style="color: #000000;">x</span> <span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
<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>
<!--</lang>-->
<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>-->
{{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}}==
<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 .) )</lang>
'((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">
<lang PL/I>
f: procedure (x) returns (float (18));
declare (c1, c2) float complex,
declare x float (18);
(a, b, c, x1, x2) float;
return (x**3 - 3*x**2 + 2*x );
end f;


declare eps float, (x, y) float (18);
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;
</lang>


=={{header|Python}}==
eps = 1e-12;
{{libheader|NumPy}}
This solution compares the naïve method with three "better" methods.
<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)))</lang>
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}}==
<lang R>qroots <- function(a, b, c) {
{{trans|Octave}}
<syntaxhighlight lang="r">f <- function(x) x^3 -3*x^2 + 2*x
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)))
x <- 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</lang>


Using the builtin '''polyroot''' function (note the order of coefficients is reversed):
<syntaxhighlight lang="racket">
#lang racket


<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</lang>
;; 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
<lang Racket>#lang racket
;; with absolute accuracy (tolerance).
(define (root? f x) (almost-equal? 0 (f x)))
(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)</lang>


=={{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))))


Raku has complex number handling built in.
(define tolerance (make-parameter 5e-16))
</syntaxhighlight>


<lang perl6>for
Different root-finding methods
[1, 2, 1],
[1, 2, 3],
[1, -2, 1],
[1, 0, -4],
[1, -10**6, 1]
-> @coefficients {
printf "Roots for %d, %d, %d\t=> (%s, %s)\n",
|@coefficients, |quadroots(@coefficients);
}


sub quadroots (*[$a, $b, $c]) {
<syntaxhighlight lang="racket">
( -$b + $_ ) / (2 * $a),
(define (secant f a b)
(let next ([x1 a] [y1 (f a)] [x2 b] [y2 (f b)] [n 50])
( -$b - $_ ) / (2 * $a)
given
(define x3 (/ (- (* x1 y2) (* x2 y1)) (- y2 y1)))
($b ** 2 - 4 * $a * $c ).Complex.sqrt.narrow
(cond
}</lang>
; if the method din't converge within given interval
{{out}}
; switch to more robust bisection method
<pre>Roots for 1, 2, 1 => (-1, -1)
[(or (not (< a x3 b)) (zero? n)) (bisection f a b)]
Roots for 1, 2, 3 => (-1+1.4142135623731i, -1-1.4142135623731i)
[(almost-equal? x3 x2) x3]
[else (next x2 y2 x3 (f x3) (sub1 n))])))
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 (bisection f x1 x2)
===version 1===
(let divide ([a x1] [b x2])
The REXX language doesn't have a &nbsp; '''sqrt''' &nbsp; function, &nbsp; nor does it support complex numbers natively.
(and (<= (* (f a) (f b)) 0)
(let ([c (* 0.5 (+ a b))])
(if (almost-equal? a b)
c
(or (divide a c) (divide c b)))))))
</syntaxhighlight>


Since "unlimited" decimal precision is part of the REXX language, the &nbsp; '''numeric digits''' &nbsp; was increased
Examples:
<br>(from a default of &nbsp; '''9''') &nbsp; to &nbsp; '''200''' &nbsp; to accommodate when a root is closer to zero than the other root.
<syntaxhighlight lang="racket">
-> (find-root (λ (x) (- 2. (* x x))) 1 2)
1.414213562373095
-> (sqrt 2)
1.4142135623730951


Note that only nine decimal digits (precision) are shown in the &nbsp; ''displaying'' &nbsp; of the output.
-> (define (f x) (+ (* x x x) (* -3.0 x x) (* 2.0 x)))
-> (find-roots f -3 4 #:divisions 50)
'(2.4932181969624796e-33 1.0 2.0)
</syntaxhighlight>


This REXX version supports &nbsp; ''complex numbers'' &nbsp; for the result.
In order to provide a comprehensive code the given solution does not optimize the number of function calls.
<lang rexx>/*REXX program finds the roots (which may be complex) of a quadratic function. */
The functional nature of Racket allows to perform the optimization without changing the main code using memoization.
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. */</lang>
{{out|output|text=&nbsp; when using the input of: &nbsp; &nbsp; <tt> 1 &nbsp; -10e5 &nbsp; 1 </tt>}}
<pre>
a = 1
b = -1000000
c = 1


root1 = 1000000
Simple memoization operator
root2 = 0.000001
<syntaxhighlight lang="racket">
</pre>
(define (memoized f)
The following output is when Regina 3.9.3 REXX is used.
(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>


{{out|output|text=&nbsp; when using the input of: &nbsp; &nbsp; <tt> 1 &nbsp; -10e9 &nbsp; 1 </tt>}}
To use memoization just call
<pre>
<syntaxhighlight lang="racket">
a = 1
-> (find-roots (memoized f) -3 4 #:divisions 50)
b = -1.0E+10
'(2.4932181969624796e-33 1.0 2.0)
c = 1
</syntaxhighlight>


root1 = 1.000000000E+10
The profiling shows that memoization reduces the number of function calls
root2 = 1E-10
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 R4 REXX is used.


{{out|output|text=&nbsp; when using the input of: &nbsp; &nbsp; <tt> 1 &nbsp; -10e9 &nbsp; 1 </tt>}}
=={{header|Raku}}==
<pre>
(formerly Perl 6)
a = 1
Uses exact arithmetic.
b = -1E+10
<syntaxhighlight lang="raku" line>sub f(\x) { x³ - 3*x² + 2*x }
c = 1


root1 = 1E+10
my $start = -1;
root2 = 0.0000000001
my $stop = 3;
</pre>
my $step = 0.001;
{{out|output|text=&nbsp; when using the input of: &nbsp; &nbsp; <tt> 3 &nbsp; 2 &nbsp; 1 </tt>}}
<pre>
a = 3
b = 2
c = 1


root1 = -0.333333333+0.471404521i
for $start, * + $step ... $stop -> $x {
root2 = -0.333333333-0.471404521i
state $sign = 0;
</pre>
given f($x) {
{{out|output|text=&nbsp; when using the input of: &nbsp; &nbsp; <tt> 1 &nbsp; 0 &nbsp; 1 </tt>
my $next = .sign;
<pre>
when 0.0 {
a = 1
say "Root found at $x";
}
b = 0
c = 1
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 = 0+1i
=={{header|REXX}}==
root2 = 0-1i
Both of these REXX versions use the &nbsp; '''bisection method'''.
===function coded as a REXX function===
<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=&nbsp; when using the defaults for input:}}
<pre>
found an exact root at 0
found an exact root at 1
found an exact root at 2
</pre>
</pre>


===function coded in-line===
=== Version 2 ===
<lang rexx>/* REXX ***************************************************************
This version is about &nbsp; '''40%''' &nbsp; faster than the 1<sup>st</sup> REXX version.
* 26.07.2913 Walter Pachl
<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*/
Numeric Digits 30
if bot=='' | bot=="," then bot= -5 /*Not specified? Then use the default.*/
Parse Arg a b c 1 alist
if top=='' | top=="," then top= +5 /* " " " " " " */
Select
if inc=='' | inc=="," then inc= .0001 /* " " " " " " */
When a='' | a='?' Then
x= bot - inc /*compute 1st value to start compares. */
Call exit 'rexx qgl a b c solves a*x**2+b*x+c'
z= x * (x * (x-3) + 2) /*formula used ──► x^3 - 3x^2 + 2x */
When words(alist)<>3 Then
!= sign(z) /*obtain the sign of the initial value.*/
Call exit 'three numbers are required'
do x=bot to top by inc /*traipse through the specified range. */
Otherwise
z= x * (x * (x-3) + 2); $= sign(z) /*compute new value; obtain the sign. */
Nop
if z=0 then say 'found an exact root at' x/1
End
else if !\==$ then if !\==0 then say 'passed a root at' x/1
gl=a'*x**2'
!= $ /*use the new sign for the next compare*/
Select
end /*x*/ /*dividing by unity normalizes X [↑] */</syntaxhighlight>
When b<0 Then gl=gl||b'*x'
{{out|output|text=&nbsp; is the same as the 1<sup>st</sup> REXX version.}} <br><br>
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
=={{header|Ring}}==
If d<0 Then Do
<syntaxhighlight lang="ring">
dd=sqrt(-d)
load "stdlib.ring"
r=-b/(2*a)
function = "return pow(x,3)-3*pow(x,2)+2*x"
i=dd/(2*a)
rangemin = -1
x1=r'+'i'i'
rangemax = 3
x2=r'-'i'i'
stepsize = 0.001
End
accuracy = 0.1
Else Do
roots(function, rangemin, rangemax, stepsize, accuracy)
dd=sqrt(d)
x1=(-b+dd)/(2*a)
func roots funct, min, max, inc, eps
x2=(-b-dd)/(2*a)
oldsign = 0
End
for x = min to max step inc
Say 'x1='||x1
num = sign(eval(funct))
Say 'x2='||x2
if num = 0
Exit
see "root found at x = " + x + nl
sqrt:
num = -oldsign
/* REXX ***************************************************************
else if num != oldsign and oldsign != 0
* EXEC to calculate the square root of x with high precision
if inc < eps
**********************************************************************/
see "root found near x = " + x + nl
Parse Arg x
else roots(funct, x-inc, x+inc/8, inc/8, eps) ok ok ok
prec=digits()
oldsign = num
prec1=2*prec
next
eps=10**(-prec1)
</syntaxhighlight>
k = 1
Output:
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</lang>
{{out}}
<pre>
<pre>
Version 1:
root found near x = 0.00
root found near x = 1.00
a = 1
root found near x = 2.00
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;
return rval;
};


=={{header|Ring}}==
>> findroot(f, , [-5,5])
<lang>
0
x1 = 0
</syntaxhighlight>
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
For a detailed description of the solver and its parameters interested reader is directed to the ''rlabplus'' manual.
sqrtDiscriminant = sqrt(pow(b,2) - 4*a*c)
x1 = (-b + sqrtDiscriminant) / (2.0*a)
x2 = (-b - sqrtDiscriminant) / (2.0*a)
return [x1, x2]
</lang>


=={{header|Ruby}}==
=={{header|Ruby}}==
{{works with|Ruby|1.9.3+}}
{{trans|Python}}
The CMath#sqrt method will return a Complex instance if necessary.
<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
end


p quadratic(3, 4, 4/3.0) # [-2/3]
def find_roots(f, range, step=0.001)
p quadratic(3, 2, -1) # [1/3, -1]
sign = sign(f[range.begin])
p quadratic(3, 2, 1) # [(-1/3 + sqrt(2/9)i), (-1/3 - sqrt(2/9)i)]
range.step(step) do |x|
p quadratic(1, 0, 1) # [(0+i), (0-i)]
value = f[x]
p quadratic(1, -1e6, 1) # [1e6, 1e-6]
if value == 0
p quadratic(-2, 7, 15) # [-3/2, 5]
puts "Root found at #{x}"
p quadratic(1, -2, 1) # [1]
elsif sign(value) == -sign
p quadratic(1, 3, 3) # [(-3 + sqrt(3)i)/2), (-3 - sqrt(3)i)/2)]</lang>
puts "Root found between #{x-step} and #{x}"
end
sign = sign(value)
end
end

f = lambda { |x| x**3 - 3*x**2 + 2*x }
find_roots(f, -1..3)</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:
<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
self <=> 0
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</lang><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|
<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}"
elsif value.sign == -sign
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)))
}
}
}</lang>
Usage:
<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
}</lang>
{{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);
<lang scheme>(define (quadratic a b c)
}</syntaxhighlight>
(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)</lang>
===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}}
<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;</lang>


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">func f(x) {
<lang ruby>var sets = [
x*x*x - 3*x*x + 2*x
[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
}</lang>
 
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>
{{out}}
{{out}}
<pre>Root found at 0
<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}}==
<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 |
+-------------------------------+</lang>


=={{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).
<lang tcl>package require math::complexnumbers
<syntaxhighlight lang="tcl">proc froots {lambda {start -3} {end 3} {step 0.0001}} {
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 sign [sgn [apply $lambda $x]]
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 lastsign $sign
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 $res
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)}</lang>
{{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>.
<lang>solve(x^2-1E9x+1.0)</lang>

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-fmt}}
{{libheader|Wren-complex}}
<syntaxhighlight lang="ecmascript">import "/fmt" for Fmt
<lang ecmascript>import "/complex" for Complex


var secant = Fn.new { |f, x0, x1|
var quadratic = Fn.new { |a, b, c|
var f0 = 0
var d = b*b - 4*a*c
var f1 = f.call(x0)
if (d == 0) {
for (i in 0...100) {
// single root
f0 = f1
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)
}
}
return [0, ""]
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 findRoots = Fn.new { |f, lower, upper, step|
var test = Fn.new { |a, b, c|
System.write("coefficients: %(a), %(b), %(c) -> ")
var x0 = lower
var x1 = lower + step
var roots = quadratic.call(a, b, c)
while (x0 < upper) {
var r = roots[0]
x1 = (x1 < upper) ? x1 : upper
if (r.count == 1) {
var res = secant.call(f, x0, x1)
System.print("one real root: %(r[0])")
var r = res[0]
} else if (r.count == 2) {
var status = res[1]
System.print("two real roots: %(r[0]) and %(r[1])")
} else {
if (status != "" && r >= x0 && r < x1) {
Fmt.print(" $6.3f $s", r, status)
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])</lang>


{{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|zkl}}==
=={{header|zkl}}==
zkl doesn't have a complex number package.
{{trans|Haskell}}
{{trans|Elixir}}
<syntaxhighlight lang="zkl">fcn findRoots(f,start,stop,step,eps){
<lang zkl>fcn quadratic(a,b,c){ b=b.toFloat();
[start..stop,step].filter('wrap(x){ f(x).closeTo(0.0,eps) })
println("Roots of a quadratic function %s, %s, %s".fmt(a,b,c));
}</syntaxhighlight>
d,a2:=(b*b - 4*a*c), a+a;
<syntaxhighlight lang="zkl">fcn f(x){ x*x*x - 3.0*x*x + 2.0*x }
if(d>0){
findRoots(f, -1.0, 3.0, 0.0001, 0.00000001).println();</syntaxhighlight>
sd:=d.sqrt();
{{out}}
println(" the real roots are %s and %s".fmt((-b + sd)/a2,(-b - sd)/a2));
<pre>L(-9.38176e-14,1,2)</pre>
{{trans|C}}
<syntaxhighlight lang="zkl">fcn secant(f,xA,xB){
reg e=1.0e-12;

fA:=f(xA); if(fA.closeTo(0.0,e)) return(xA);

do(50){
fB:=f(xB);
d:=(xB - xA) / (fB - fA) * fB;
if(d.closeTo(0,e)) break;
xA = xB; fA = fB; xB -= d;
}
}
else if(d==0) println(" the single root is ",-b/a2);
if(f(xB).closeTo(0.0,e)) xB
else{
else "Function is not converging near (%7.4f,%7.4f).".fmt(xA,xB);
sd:=(-d).sqrt();
}</syntaxhighlight>
println(" the complex roots are %s and \U00B1;%si".fmt(-b/a2,sd/a2));
<syntaxhighlight lang="zkl">step:=0.1;
}
xs:=findRoots(f, -1.032, 3.0, step, 0.1);
}</lang>
xs.println(" --> ",xs.apply('wrap(x){ secant(f,x-step,x+step) }));</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)
}</lang>
{{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}}

Revision as of 01:09, 8 December 2022

Task
Roots of a quadratic function
You are encouraged to solve this task according to the task description, using any language you may know.
This task has been clarified. Its programming examples are in need of review to ensure that they still fit the requirements of the task.

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: <lang 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;</lang>

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

<lang 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)</lang>
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

<lang 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;</lang> 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

Translation of: Ada
Works with: ALGOL 68 version Revision 1 - no extensions to language used
Works with: ALGOL 68G version Any - tested with release 1.18.0-9h.tiny

<lang algol68>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);
  1. 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 #</lang>

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 <lang AutoHotkey>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

}</lang>

BBC BASIC

<lang bbcbasic> 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</lang>
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) <lang C>#include <stdio.h>

  1. include <stdlib.h>
  2. include <complex.h>
  3. 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; }</lang>

Output:
(-1e+12 + 0 i), (-1 + 0 i)
(1.00208e+07 + 0 i), (9.9792e-08 + 0 i)

<lang c>#include <stdio.h>

  1. include <math.h>
  2. 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);

}</lang>

Translation of: C++

<lang c>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;
 }

}</lang>

<lang c>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;

}</lang> 

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#

<lang csharp>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));
   }

}</lang>

Output:
((1E+20, 0), (1E-20, 0))

C++

<lang cpp>#include <iostream>

  1. include <utility>
  2. 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;

}</lang>

Output:
(1e+20,0), (1e-20,0)

Clojure

<lang 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</lang>
Output:

<lang clojure>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] </lang>

Common Lisp

<lang 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))))</lang>

D

<lang 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));

}</lang>

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

<lang 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)</lang>

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

<lang>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</lang>

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

Translation of: Ada

<lang 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 * / ;</lang>

<lang factor>( scratchpad ) 1 -1.e20 1 quadratic-equation --- Data stack: 1.0e+20 9.999999999999999e-21</lang>

Middlebrook method <lang factor>:: 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 / ;

</lang>


<lang factor>( scratchpad ) 1 -1.e20 1 quadratic-equation --- Data stack: 1.0e+20 1.0e-20</lang>

Forth

Without locals: <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/ ;</lang>

With locals: <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 1 set-precision 1e -1e6 1e quadratic fs. fs. \ 1e-6 1e6</lang>

Fortran

Fortran 90

Works with: Fortran version 90 and later

<lang fortran>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</lang>
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. <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

</lang>

FreeBASIC

Library: GMP

<lang freebasic>' version 20-12-2020 ' compile with: fbc -s console

  1. 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</lang>

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

<lang 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;

  1. Hint : E(12) is a 12th primitive root of 1

QuadraticRoots(2, 2, -1);

  1. [ 1/2*E(12)^4-1/2*E(12)^7+1/2*E(12)^8+1/2*E(12)^11,
  2. 1/2*E(12)^4+1/2*E(12)^7+1/2*E(12)^8-1/2*E(12)^11 ]
  1. This works also with floating-point numbers

QuadraticRoots(2.0, 2.0, -1.0);

  1. [ 0.366025, -1.36603 ]</lang>

Go

<lang 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])
   }

}</lang>

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

<lang 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)
   ]</lang>
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

Translation of: Ada

Works in both languages. <lang unicon>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</lang>

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

<lang 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</lang>

IS-BASIC

<lang 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</lang>

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:

<lang j> 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</lang>

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 : <lang j> 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</lang>

Exploring the limits of precision:

<lang j> 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</lang>

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

<lang 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</lang>

Java

<lang 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]);
           }
       }
   }

}</lang>

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

Works with: jq version 1.4

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)

<lang jq># 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;
  1. 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 ;</lang>

Section 2: quadratic_roots(a;b;c) <lang jq># If there are infinitely many solutions, emit true;

  1. if none, emit empty;
  2. otherwise always emit two.
  3. 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
</lang>

Section 3: Produce a table showing [i, error, solution] for solutions to x^2 - 10^i + 1 = 0 <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</lang>

Output:

(scrolling window)

<lang sh> $ 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]</lang>

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.

<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

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</lang>

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)

Kotlin

Translation of: Java

<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) {
       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) }

}</lang>

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

<lang scheme> 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

</lang>

Liberty BASIC

<lang lb>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</lang>

<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</lang>

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:

<lang lua>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</lang> 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

<lang 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);</lang>

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): <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}]</lang> 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

<lang Matlab>roots([1 -3 2])  % coefficients in decreasing order of power e.g. [x^n ... x^2 x^1 x^0]</lang>

Maxima

<lang 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] */</lang>

МК-61/52

<lang>П2 С/П /-/ <-> / 2 / П3 x^2 С/П ИП2 / - Вx <-> КвКор НОП x>=0 28 ИП3 x<0 24 <-> /-/ + / Вx С/П /-/ КвКор ИП3 С/П</lang>

Input: a С/П b С/П c С/П

Output:

x1 - РX; x2 - РY (or error message, if D < 0).

Modula-3

Translation of: Ada

<lang modula3>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.</lang>

Nim

<lang 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}"</lang>
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

<lang 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))
</lang>
Output:

<lang ocaml># quadsolve 1.0 0.0 (-2.0) ;; - : quadroots = RealRoots (-1.4142135623730951, 1.4142135623730949)

  1. quadsolve 1.0 0.0 2.0 ;;

- : quadroots = ComplexRoots ({Complex.re = 0.; Complex.im = 1.4142135623730951}, 

{Complex.re = 0.; Complex.im = -1.4142135623730951})
  1. quadsolve 1.0 (-1.0e5) 1.0 ;;

- : quadroots = RealRoots (99999.99999, 1.0000000001000001e-005)</lang>

Octave

See MATLAB.

PARI/GP

Works with: PARI/GP version 2.8.0+

<lang parigp>roots(a,b,c)=polrootsreal(Pol([a,b,c]))</lang>

Translation of: C

Otherwise, coding directly: <lang parigp>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]
 )

};</lang>

Either way, <lang parigp>roots(1,-1e9,1)</lang> gives one root around 0.000000001000000000000000001 and one root around 999999999.999999999.

Pascal

some parts translated from Modula2 <lang pascal>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. </lang>

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. <lang perl>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); }</lang>

Phix

Translation of: ERRE
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

<lang 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 .) )</lang>
Output:
-> ("999,999.999999" "0.000001")

PL/I

<lang 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;

</lang>

Python

Library: NumPy

This solution compares the naïve method with three "better" methods. <lang python>#!/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)))</lang>
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

<lang 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</lang>

Using the builtin polyroot function (note the order of coefficients is reversed):

<lang R>polyroot(c(2i, 0, 1)) [1] -1+1i 1-1i

polyroot(c(1, -1e9, 1)) [1] 1e-09+0i 1e+09+0i</lang>

Racket

<lang 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)</lang>

Raku

(formerly Perl 6)

Raku has complex number handling built in.

<lang perl6>for [1, 2, 1], [1, 2, 3], [1, -2, 1], [1, 0, -4], [1, -10**6, 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 ** 2 - 4 * $a * $c ).Complex.sqrt.narrow

}</lang>

Output:
Roots for 1, 2, 1       => (-1, -1)
Roots for 1, 2, 3       => (-1+1.4142135623731i, -1-1.4142135623731i)
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. <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*/ 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. */</lang>
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

<lang rexx>/* 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</lang>

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

<lang> 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]

</lang>

Ruby

Works with: Ruby version 1.9.3+

The CMath#sqrt method will return a Complex instance if necessary. <lang ruby>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)]</lang>

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

<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) 

   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</lang>

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. <lang scala>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)))
   }	
 }

}</lang> Usage: <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

}</lang>

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

<lang 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)</lang>

Seed7

Translation of: Ada

<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;</lang>
Output:
X1 = 1000000.000000 X2 = 0.000001

Sidef

<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| 

   say ("Roots for #{coefficients}",
       "=> (#{quadroots(coefficients...).join(', ')})")

}</lang>

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

<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  |
   +-------------------------------+</lang>

Tcl

Library: Tcllib (Package: math::complexnumbers)

<lang 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"
   }

}

  1. 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}

  1. 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)}</lang>

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. <lang>solve(x^2-1E9x+1.0)</lang> returns 

x=1.E-9 or x=1.E9

Wren

Translation of: Go
Library: Wren-complex

<lang ecmascript>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])</lang>

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

zkl

zkl doesn't have a complex number package.

Translation of: Elixir

<lang zkl>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));
  }

}</lang> <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)

}</lang>

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
Retrieved from "https://rosettacode.org/wiki/Roots_of_a_quadratic_function?oldid=334155"