aparler/RosettaCodeData
1
0
Fork 0
Code Issues 12 Pull requests 3 Projects Releases Packages Wiki Activity Actions

Data commit

Browse source
This commit is contained in:
Ingy döt Net 2023-07-01 11:58:00 -04:00
parent 7387c8f97b
commit cb5bb5e222
199093 changed files with 3378972 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

3
Task/Roots-of-a-function/00-META.yaml Normal file
View file

@ -0,0 +1,3 @@
---
from: http://rosettacode.org/wiki/Roots_of_a_function
note: Arithmetic operations

9
Task/Roots-of-a-function/00-TASK.txt Normal file
View file

@ -0,0 +1,9 @@
;Task:
Create a program that finds and outputs the roots of a given function, range and (if applicable) step width.
The program should identify whether the root is exact or approximate.
For this task, use: &nbsp; &nbsp; <big><big> ƒ(x) &nbsp; = &nbsp; x<sup>3</sup> - 3x<sup>2</sup> + 2x </big></big>
<br><br>

20
Task/Roots-of-a-function/11l/roots-of-a-function.11l Normal file
View file

@ -0,0 +1,20 @@
F f(x)
R x^3 - 3 * x^2 + 2 * x
-V step = 0.001
-V start = -1.0
-V stop = 3.0
V sgn = f(start) > 0
V x = start
L x <= stop
V value = f(x)
I value == 0
print(‘Root found at ’x)
E I (value > 0) != sgn
print(‘Root found near ’x)
sgn = value > 0
x += step

70
Task/Roots-of-a-function/ALGOL-68/roots-of-a-function.alg Normal file
View file

@ -0,0 +1,70 @@
MODE DBL = LONG REAL;
FORMAT dbl = $g(-long real width, long real width-6, -2)$;
MODE XY = STRUCT(DBL x, y);
FORMAT xy root = $f(dbl)" ("b("Exactly", "Approximately")")"$;
MODE DBLOPT = UNION(DBL, VOID);
MODE XYRES = UNION(XY, VOID);
PROC find root = (PROC (DBL)DBL f, DBLOPT in x1, in x2, in x error, in y error)XYRES:(
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 #
x2 := (in x2|(DBL x2):x2|+5.0),
x error := (in x error|(DBL x error):x error|small real),
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
XY(x1, y1) # we already have a solution! #
ELSE
FOR i WHILE
y2 := f(x2);
IF y2 = 0 THEN stop iteration FI;
IF i = limit THEN value error FI;
IF y1 = y2 THEN value error FI;
dy := y1 - y2;
dx := dx / dy * y2;
x1 := x2; y1 := y2; # retain for next iteration #
x2 -:= dx;
# WHILE # ABS dx > x error AND ABS dy > y error DO
SKIP
OD;
stop iteration:
XY(x2, y2) EXIT
value error:
EMPTY
FI
);
PROC f = (DBL x)DBL: x UP 3 - LONG 3.1 * x UP 2 + LONG 2.0 * x;
DBL first root, second root, third root;
XYRES first result = find root(f, LENG -1.0, LENG 3.0, EMPTY, EMPTY);
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;
XYRES second result = find root( (DBL x)DBL: f(x) / (x - first root), EMPTY, EMPTY, EMPTY, EMPTY);
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;
XYRES third result = find root( (DBL x)DBL: f(x) / (x - first root) / ( x - second root ), EMPTY, EMPTY, EMPTY, EMPTY);
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

46
Task/Roots-of-a-function/ATS/roots-of-a-function.ats Normal file
View file

@ -0,0 +1,46 @@
#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)

39
Task/Roots-of-a-function/Ada/roots-of-a-function.ada Normal file
View file

@ -0,0 +1,39 @@
with Ada.Text_Io; use Ada.Text_Io;
procedure Roots_Of_Function is
package Real_Io is new Ada.Text_Io.Float_Io(Long_Float);
use Real_Io;
function F(X : Long_Float) return Long_Float is
begin
return (X**3 - 3.0*X*X + 2.0*X);
end F;
Step : constant Long_Float := 1.0E-6;
Start : constant Long_Float := -1.0;
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;
Sign := Value > 0.0;
X := X + Step;
end loop;
end Roots_Of_Function;

21
Task/Roots-of-a-function/Arturo/roots-of-a-function.arturo Normal file
View file

@ -0,0 +1,21 @@
f: function [n]->
((n^3) - 3*n^2) + 2*n
step: 0.01
start: neg 1.0
stop: 3.0
sign: positive? f start
x: start
while [x =< stop][
value: f x
if? value = 0 ->
print ["root found at" to :string .format:".5f" x]
else ->
if sign <> value > 0 -> print ["root found near" to :string .format:".5f" x]
sign: value > 0
'x + step
]

36
Task/Roots-of-a-function/AutoHotkey/roots-of-a-function.ahk Normal file
View file

@ -0,0 +1,36 @@
MsgBox % roots("poly", -0.99, 2, 0.1, 1.0e-5)
MsgBox % roots("poly", -1, 3, 0.1, 1.0e-5)
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)
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
}
Sort res, UN ; remove duplicate endpoints
Return res
}
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
}
}
poly(x) {
Return ((x-3)*x+2)*x
}

2
Task/Roots-of-a-function/Axiom/roots-of-a-function-1.axiom Normal file
View file

@ -0,0 +1,2 @@
expr := x^3-3*x^2+2*x
solve(expr,x)

2
Task/Roots-of-a-function/Axiom/roots-of-a-function-2.axiom Normal file
View file

@ -0,0 +1,2 @@
(1) [x= 2,x= 1,x= 0]
Type: List(Equation(Fraction(Polynomial(Integer))))

15
Task/Roots-of-a-function/Axiom/roots-of-a-function-3.axiom Normal file
View file

@ -0,0 +1,15 @@
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."

1
Task/Roots-of-a-function/Axiom/roots-of-a-function-4.axiom Normal file
View file

@ -0,0 +1 @@
secant(expr=0,x=-0.5..0.5)

27
Task/Roots-of-a-function/BBC-BASIC/roots-of-a-function.basic Normal file
View file

@ -0,0 +1,27 @@
function$ = "x^3-3*x^2+2*x"
rangemin = -1
rangemax = 3
stepsize = 0.001
accuracy = 1E-8
PROCroots(function$, rangemin, rangemax, stepsize, accuracy)
END
DEF PROCroots(func$, min, max, inc, eps)
LOCAL x, sign%, oldsign%
oldsign% = 0
FOR x = min TO max STEP inc
sign% = SGN(EVAL(func$))
IF sign% = 0 THEN
PRINT "Root found at x = "; x
sign% = -oldsign%
ELSE IF sign% <> oldsign% AND oldsign% <> 0 THEN
IF inc < eps THEN
PRINT "Root found near x = "; x
ELSE
PROCroots(func$, x-inc, x+inc/8, inc/8, eps)
ENDIF
ENDIF
ENDIF
oldsign% = sign%
NEXT x
ENDPROC

36
Task/Roots-of-a-function/C++/roots-of-a-function-1.cpp Normal file
View file

@ -0,0 +1,36 @@
#include <iostream>
double f(double x)
{
return (x*x*x - 3*x*x + 2*x);
}
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);
double sign = (value > 0);
// Check for root at start
if ( 0 == value )
std::cout << "Root found at " << start << std::endl;
for( double x = start + step;
x <= stop;
x += step )
{
value = f(x);
if ( ( value > 0 ) != sign )
// We passed a root
std::cout << "Root found near " << x << std::endl;
else if ( 0 == value )
// We hit a root
std::cout << "Root found at " << x << std::endl;
// Update our sign
sign = ( value > 0 );
}
}

97
Task/Roots-of-a-function/C++/roots-of-a-function-2.cpp Normal file
View file

@ -0,0 +1,97 @@
#include <iostream>
#include <cmath>
#include <algorithm>
#include <functional>
double brents_fun(std::function<double (double)> f, double lower, double upper, double tol, unsigned int max_iter)
{
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
if (!(fa * fb < 0))
{
std::cout << "Signs of f(lower_bound) and f(upper_bound) must be opposites" << std::endl; // throws exception if root isn't bracketed
return -11;
}
if (std::abs(fa) < std::abs(b)) // if magnitude of f(lower_bound) is less than magnitude of f(upper_bound)
{
std::swap(a,b);
std::swap(fa,fb);
}
double c = a; // c now equals the largest magnitude of the lower and upper bounds
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
double s = 0; // Our Root that will be returned
double d = 0; // Only used if mflag is unset (mflag == false)
for (unsigned int iter = 1; iter < max_iter; ++iter)
{
// stop if converged on root or error is less than tolerance
if (std::abs(b-a) < tol)
{
std::cout << "After " << iter << " iterations the root is: " << s << std::endl;
return s;
} // end if
if (fa != fc && fb != fc)
{
// use inverse quadratic interopolation
s = ( a * fb * fc / ((fa - fb) * (fa - fc)) )
+ ( b * fa * fc / ((fb - fa) * (fb - fc)) )
+ ( c * fa * fb / ((fc - fa) * (fc - fb)) );
}
else
{
// secant method
s = b - fb * (b - a) / (fb - fa);
}
// 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 && (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;
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 (std::abs(fa) < std::abs(fb)) // if magnitude of fa is less than magnitude of fb
{
std::swap(a,b); // swap a and b
std::swap(fa,fb); // make sure f(a) and f(b) are correct after swap
}
} // end for
std::cout<< "The solution does not converge or iterations are not sufficient" << std::endl;
} // end brents_fun

34
Task/Roots-of-a-function/C-sharp/roots-of-a-function-1.cs Normal file
View file

@ -0,0 +1,34 @@
using System;
class Program
{
public static void Main(string[] args)
{
Func<double, double> f = x => { return x * x * x - 3 * x * x + 2 * x; };
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;
}
}
}

43
Task/Roots-of-a-function/C-sharp/roots-of-a-function-2.cs Normal file
View file

@ -0,0 +1,43 @@
using System;
class Program
{
private static int Sign(double x)
{
return x < 0.0 ? -1 : x > 0.0 ? 1 : 0;
}
public static void PrintRoots(Func<double, double> f, double lowerBound,
double upperBound, double step)
{
double x = lowerBound, ox = x;
double y = f(x), oy = y;
int s = Sign(y), os = s;
for (; x <= upperBound; x += step)
{
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);
}
ox = x;
oy = y;
os = s;
}
}
public static void Main(string[] args)
{
Func<double, double> f = x => { return x * x * x - 3 * x * x + 2 * x; };
PrintRoots(f, -1.0, 4, 0.002);
}
}

106
Task/Roots-of-a-function/C-sharp/roots-of-a-function-3.cs Normal file
View file

@ -0,0 +1,106 @@
using System;
class Program
{
public static void Main(string[] args)
{
Func<double, double> f = x => { return x * x * x - 3 * x * x + 2 * x; };
double root = BrentsFun(f, lower: -1.0, upper: 4, tol: 0.002, maxIter: 100);
}
private static void Swap<T>(ref T a, ref T b)
{
var tmp = a;
a = b;
b = tmp;
}
public static double BrentsFun(Func<double, double> f, double lower, double upper, double tol, uint maxIter)
{
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;
if (!(fa * fb < 0))
throw new ArgumentException("Signs of f(lower_bound) and f(upper_bound) must be opposites");
if (Math.Abs(fa) < Math.Abs(b)) // if magnitude of f(lower_bound) is less than magnitude of f(upper_bound)
{
Swap(ref a, ref b);
Swap(ref fa, ref fb);
}
double c = a; // c now equals the largest magnitude of the lower and upper bounds
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
double s = 0; // Our Root that will be returned
double d = 0; // Only used if mflag is unset (mflag == false)
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
}

60
Task/Roots-of-a-function/C/roots-of-a-function-1.c Normal file
View file

@ -0,0 +1,60 @@
#include <math.h>
#include <stdio.h>
double f(double x)
{
return x*x*x-3.0*x*x +2.0*x;
}
double secant( double xA, double xB, double(*f)(double) )
{
double e = 1.0e-12;
double fA, fB;
double d;
int i;
int limit = 50;
fA=(*f)(xA);
for (i=0; i<limit; i++) {
fB=(*f)(xB);
d = (xB - xA) / (fB - fA) * fB;
if (fabs(d) < e)
break;
xA = xB;
fA = fB;
xB -= d;
}
if (i==limit) {
printf("Function is not converging near (%7.4f,%7.4f).\n", xA,xB);
return -99.0;
}
return xB;
}
int main(int argc, char *argv[])
{
double step = 1.0e-2;
double e = 1.0e-12;
double x = -1.032; // just so we use secant method
double xx, value;
int s = (f(x)> 0.0);
while (x < 3.0) {
value = f(x);
if (fabs(value) < e) {
printf("Root found at x= %12.9f\n", x);
s = (f(x+.0001)>0.0);
}
else if ((value > 0.0) != s) {
xx = secant(x-step, x,&f);
if (xx != -99.0) // -99 meaning secand method failed
printf("Root found at x= %12.9f\n", xx);
else
printf("Root found near x= %7.4f\n", x);
s = (f(x+.0001)>0.0);
}
x += step;
}
return 0;
}

17
Task/Roots-of-a-function/C/roots-of-a-function-2.c Normal file
View file

@ -0,0 +1,17 @@
#include <gsl/gsl_poly.h>
#include <stdio.h>
int main(int argc, char *argv[])
{
/* 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;
}

2
Task/Roots-of-a-function/Clojure/roots-of-a-function.clj Normal file
View file

@ -0,0 +1,2 @@
(defn findRoots [f start stop step eps]
(filter #(-> (f %) Math/abs (< eps)) (range start stop step)))

35
Task/Roots-of-a-function/CoffeeScript/roots-of-a-function-1.coffee Normal file
View file

@ -0,0 +1,35 @@
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
do ->
# Smaller steps produce more accurate/precise results in general,
# but for many functions we'll never get exact roots, either due
# to imperfect binary representation or irrational roots.
step = 1 / 256
f1 = (x) -> x*x*x - 3*x*x + 2*x
print_roots f1, -1, 5, step
f2 = (x) -> x*x - 4*x + 3
print_roots f2, -1, 5, step
f3 = (x) -> x - 1.5
print_roots f3, 0, 4, step
f4 = (x) -> x*x - 2
print_roots f4, -2, 2, step

13
Task/Roots-of-a-function/CoffeeScript/roots-of-a-function-2.coffee Normal file
View file

@ -0,0 +1,13 @@
> coffee roots.coffee
-----
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

17
Task/Roots-of-a-function/Common-Lisp/roots-of-a-function.lisp Normal file
View file

@ -0,0 +1,17 @@
(defun find-roots (function start end &optional (step 0.0001))
(let* ((roots '())
(value (funcall function start))
(plusp (plusp value)))
(when (zerop value)
(format t "~&Root found at ~W." start))
(do ((x (+ start step) (+ x step)))
((> x end) (nreverse roots))
(setf value (funcall function x))
(cond
((zerop value)
(format t "~&Root found at ~w." x)
(push x roots))
((not (eql plusp (plusp value)))
(format t "~&Root found near ~w." x)
(push (cons (- x step) x) roots)))
(setf plusp (plusp value)))))

72
Task/Roots-of-a-function/D/roots-of-a-function.d Normal file
View file

@ -0,0 +1,72 @@
import std.stdio, std.math, std.algorithm;
bool nearZero(T)(in T a, in T b = T.epsilon * 4) pure nothrow {
return abs(a) <= b;
}
T[] findRoot(T)(immutable T function(in T) pure nothrow fi,
in T start, in T end, in T step=T(0.001L),
T tolerance = T(1e-4L)) {
if (step.nearZero)
writefln("WARNING: step size may be too small.");
/// Search root by simple bisection.
T searchRoot(T a, T b) pure nothrow {
T root;
int limit = 49;
T gap = b - a;
while (!nearZero(gap) && limit--) {
if (fi(a).nearZero)
return a;
if (fi(b).nearZero)
return b;
root = (b + a) / 2.0L;
if (fi(root).nearZero)
return root;
((fi(a) * fi(root) < 0) ? b : a) = root;
gap = b - a;
}
return root;
}
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);
}
return result.keys.sort().release;
}
void report(T)(in T[] r, immutable T function(in T) pure f,
in T tolerance = T(1e-4L)) {
if (r.length) {
writefln("Root found (tolerance = %1.4g):", tolerance);
foreach (const x; r) {
immutable T y = f(x);
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.");
}
void main() {
static real f(in real x) pure nothrow {
return x ^^ 3 - (3 * x ^^ 2) + 2 * x;
}
findRoot(&f, -1.0L, 3.0L, 0.001L).report(&f);
}

51
Task/Roots-of-a-function/DWScript/roots-of-a-function.dw Normal file
View file

@ -0,0 +1,51 @@
type TFunc = function (x : Float) : Float;
function f(x : Float) : Float;
begin
Result := x*x*x-3.0*x*x +2.0*x;
end;
const e = 1.0e-12;
function Secant(xA, xB : Float; f : TFunc) : Float;
const
limit = 50;
var
fA, fB : Float;
d : Float;
i : Integer;
begin
fA := f(xA);
for i := 0 to limit do begin
fB := f(xB);
d := (xB-xA)/(fB-fA)*fB;
if Abs(d) < e then
Exit(xB);
xA := xB;
fA := fB;
xB -= d;
end;
PrintLn(Format('Function is not converging near (%7.4f,%7.4f).', [xA, xB]));
Result := -99.0;
end;
const fstep = 1.0e-2;
var x := -1.032; // just so we use secant method
var xx, value : Float;
var s := f(x)>0.0;
while (x < 3.0) do begin
value := f(x);
if Abs(value)<e then begin
PrintLn(Format("Root found at x= %12.9f", [x]));
s := (f(x+0.0001)>0.0);
end else if (value>0.0) <> s then begin
xx := Secant(x-fstep, x, f);
if xx <> -99.0 then // -99 meaning secand method failed
PrintLn(Format('Root found at x = %12.9f', [xx]))
else PrintLn(Format('Root found near x= %7.4f', [xx]));
s := (f(x+0.0001)>0.0);
end;
x += fstep;
end;

12
Task/Roots-of-a-function/Dart/roots-of-a-function.dart Normal file
View file

@ -0,0 +1,12 @@
double fn(double x) => x * x * x - 3 * x * x + 2 * x;
findRoots(Function(double) f, double start, double stop, double step, double epsilon) sync* {
for (double x = start; x < stop; x = x + step) {
if (fn(x).abs() < epsilon) yield x;
}
}
main() {
// Vector(-9.381755897326649E-14, 0.9999999999998124, 1.9999999999997022)
print(findRoots(fn, -1.0, 3.0, 0.0001, 0.000000001));
}

56
Task/Roots-of-a-function/ERRE/roots-of-a-function.erre Normal file
View file

@ -0,0 +1,56 @@
PROGRAM ROOTS_FUNCTION
!VAR E,X,STP,VALUE,S%,I%,LIMIT%,X1,X2,D
FUNCTION F(X)
F=X*X*X-3*X*X+2*X
END FUNCTION
BEGIN
X=-1
STP=1.0E-6
E=1.0E-9
S%=(F(X)>0)
PRINT("VERSION 1: SIMPLY STEPPING X")
WHILE X<3.0 DO
VALUE=F(X)
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
PRINT
PRINT("VERSION 2: SECANT METHOD")
X1=-1.0
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

11
Task/Roots-of-a-function/EchoLisp/roots-of-a-function.l Normal file
View file

@ -0,0 +1,11 @@
(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

27
Task/Roots-of-a-function/Elixir/roots-of-a-function.elixir Normal file
View file

@ -0,0 +1,27 @@
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)

28
Task/Roots-of-a-function/Erlang/roots-of-a-function.erl Normal file
View file

@ -0,0 +1,28 @@
% Implemented by Arjun Sunel
-module(roots).
-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).
while(X, Step, Start, Stop, Sign,F) ->
Value = F(X),
if
Value == 0 -> % We hit a root
io:format("Root found at ~p~n",[X]),
while(X+Step, Step, Start, Stop, Value > 0,F);
(Value < 0) == Sign -> % We passed a root
io:format("Root found near ~p~n",[X]),
while(X+Step , Step, Start, Stop, Value > 0,F);
X > Stop ->
io:format("") ;
true ->
while(X+Step, Step, Start, Stop, Value > 0,F)
end.

26
Task/Roots-of-a-function/Fortran/roots-of-a-function-1.f Normal file
View file

@ -0,0 +1,26 @@
PROGRAM ROOTS_OF_A_FUNCTION
IMPLICIT NONE
INTEGER, PARAMETER :: dp = SELECTED_REAL_KIND(15)
REAL(dp) :: f, e, x, step, value
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

22
Task/Roots-of-a-function/Fortran/roots-of-a-function-2.f Normal file
View file

@ -0,0 +1,22 @@
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

50
Task/Roots-of-a-function/FreeBASIC/roots-of-a-function.basic Normal file
View file

@ -0,0 +1,50 @@
#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

37
Task/Roots-of-a-function/Go/roots-of-a-function.go Normal file
View file

@ -0,0 +1,37 @@
package main
import (
"fmt"
"math"
)
func main() {
example := func(x float64) float64 { return x*x*x - 3*x*x + 2*x }
findroots(example, -.5, 2.6, 1)
}
func findroots(f func(float64) float64, lower, upper, step float64) {
for x0, x1 := lower, lower+step; x0 < upper; x0, x1 = x1, x1+step {
x1 = math.Min(x1, upper)
r, status := secant(f, x0, x1)
if status != "" && r >= x0 && r < x1 {
fmt.Printf(" %6.3f %s\n", r, status)
}
}
}
func secant(f func(float64) float64, x0, x1 float64) (float64, string) {
var f0 float64
f1 := f(x0)
for i := 0; i < 100; i++ {
f0, f1 = f1, f(x1)
switch {
case f1 == 0:
return x1, "exact"
case math.Abs(x1-x0) < 1e-6:
return x1, "approximate"
}
x0, x1 = x1, x1-f1*(x1-x0)/(f1-f0)
}
return 0, ""
}

4
Task/Roots-of-a-function/Haskell/roots-of-a-function-1.hs Normal file
View file

@ -0,0 +1,4 @@
f x = x^3-3*x^2+2*x
findRoots start stop step eps =
[x | x <- [start, start+step .. stop], abs (f x) < eps]

2
Task/Roots-of-a-function/Haskell/roots-of-a-function-2.hs Normal file
View file

@ -0,0 +1,2 @@
*Main> findRoots (-1.0) 3.0 0.0001 0.000000001
[-9.381755897326649e-14,0.9999999999998124,1.9999999999997022]

7
Task/Roots-of-a-function/Haskell/roots-of-a-function-3.hs Normal file
View file

@ -0,0 +1,7 @@
import Numeric.GSL.Polynomials
import Data.Complex
*Main> mapM_ print $ polySolve [0,2,-3,1]
(-5.421010862427522e-20) :+ 0.0
2.000000000000001 :+ 0.0
0.9999999999999996 :+ 0.0

4
Task/Roots-of-a-function/Haskell/roots-of-a-function-4.hs Normal file
View file

@ -0,0 +1,4 @@
*Main> mapM_ (print.realPart) $ polySolve [0,2,-3,1]
-5.421010862427522e-20
2.000000000000001
0.9999999999999996

21
Task/Roots-of-a-function/Haskell/roots-of-a-function-5.hs Normal file
View file

@ -0,0 +1,21 @@
import Control.Applicative
data Root a = Exact a | Approximate a deriving (Show, Eq)
-- looks for roots on an interval
bisection :: (Alternative f, Floating a, Ord a) =>
(a -> a) -> a -> a -> f (Root a)
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
-- looks for roots on a grid
findRoots :: (Alternative f, Floating a, Ord a) =>
(a -> a) -> [a] -> а (Root a)
findRoots f [] = empty
findRoots f [x] = if f x == 0 then pure (Exact x) else empty
findRoots f (a:b:xs) = bisection f a b <|> findRoots f (b:xs)

10
Task/Roots-of-a-function/HicEst/roots-of-a-function-1.hicest Normal file
View file

@ -0,0 +1,10 @@
OPEN(FIle='test.txt')
1 DLG(NameEdit=x0, DNum=3)
x = x0
chi2 = SOLVE(NUL=x^3 - 3*x^2 + 2*x, Unknown=x, I=iterations, NumDiff=1E-15)
EDIT(Text='approximate exact ', Word=(chi2 == 0), Parse=solution)
WRITE(FIle='test.txt', LENgth=6, Name) x0, x, solution, chi2, iterations
GOTO 1

9
Task/Roots-of-a-function/HicEst/roots-of-a-function-2.hicest Normal file
View file

@ -0,0 +1,9 @@
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;

28
Task/Roots-of-a-function/Icon/roots-of-a-function.icon Normal file
View file

@ -0,0 +1,28 @@
procedure main()
showRoots(f, -1.0, 4, 0.002)
end
procedure f(x)
return x^3 - 3*x^2 + 2*x
end
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
procedure sign(x)
return (x<0, -1) | (x>0, 1) | 0
end

2
Task/Roots-of-a-function/J/roots-of-a-function-1.j Normal file
View file

@ -0,0 +1,2 @@
1{::p. 0 2 _3 1
2 1 0

2
Task/Roots-of-a-function/J/roots-of-a-function-2.j Normal file
View file

@ -0,0 +1,2 @@
(0=]p.1{::p.) 0 2 _3 1
1 1 1

5
Task/Roots-of-a-function/J/roots-of-a-function-3.j Normal file
View file

@ -0,0 +1,5 @@
blackbox=: 0 2 _3 1&p.
(#~ (=<./)@:|@blackbox) i.&.(1e6&*)&.(1&+) 3
0 1 2
0=blackbox 0 1 2
1 1 1

38
Task/Roots-of-a-function/Java/roots-of-a-function.java Normal file
View file

@ -0,0 +1,38 @@
public class Roots {
public interface Function {
public double f(double x);
}
private static int sign(double x) {
return (x < 0.0) ? -1 : (x > 0.0) ? 1 : 0;
}
public static void printRoots(Function f, double lowerBound,
double upperBound, double step) {
double x = lowerBound, ox = x;
double y = f.f(x), oy = y;
int s = sign(y), os = s;
for (; x <= upperBound ; x += step) {
s = sign(y = f.f(x));
if (s == 0) {
System.out.println(x);
} else if (s != os) {
double dx = x - ox;
double dy = y - oy;
double cx = x - dx * (y / dy);
System.out.println("~" + cx);
}
ox = x; oy = y; os = s;
}
}
public static void main(String[] args) {
Function poly = new Function () {
public double f(double x) {
return x*x*x - 3*x*x + 2*x;
}
};
printRoots(poly, -1.0, 4, 0.002);
}
}

30
Task/Roots-of-a-function/JavaScript/roots-of-a-function.js Normal file
View file

@ -0,0 +1,30 @@
// 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);
function sign(x) {
return (x < 0.0) ? -1 : (x > 0.0) ? 1 : 0;
}
function printRoots(f, lowerBound, upperBound, step) {
var x = lowerBound, ox = x,
y = f(x), oy = y,
s = sign(y), os = s;
for (; x <= upperBound ; x += step) {
s = sign(y = f(x));
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;
}
}
printRoots(poly, -1.0, 4, 0.002);

22
Task/Roots-of-a-function/Jq/roots-of-a-function-1.jq Normal file
View file

@ -0,0 +1,22 @@
def sign:
if . < 0 then -1 elif . > 0 then 1 else 0 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] ;

14
Task/Roots-of-a-function/Jq/roots-of-a-function-2.jq Normal file
View file

@ -0,0 +1,14 @@
printRoots( .*.*. - 3*.*. + 2*.; -1.0; 4; 1/256)
[
0,
1,
2
]
printRoots( .*.*. - 3*.*. + 2*.; -1.0; 4; .001)
[
"~1.320318770141425e-18",
"~1.0000000000000002",
"~1.9999999999999993"
]

3
Task/Roots-of-a-function/Julia/roots-of-a-function-1.julia Normal file
View file

@ -0,0 +1,3 @@
using Roots
println(find_zero(x -> x^3 - 3x^2 + 2x, (-100, 100)))

21
Task/Roots-of-a-function/Julia/roots-of-a-function-2.julia Normal file
View file

@ -0,0 +1,21 @@
function newton(f, fp, x::Float64,tol=1e-14::Float64,maxsteps=100::Int64)
##f: the function of x
##fp: the derivative of f
local xnew, xold = x, Inf
local fn, fo = f(xnew), Inf
local counter = 1
while (counter < maxsteps) && (abs(xnew - xold) > tol) && ( abs(fn - fo) > tol )
x = xnew - f(xnew)/fp(xnew) ## update x
xnew, xold = x, xnew
fn, fo = f(xnew), fn
counter += 1
end
if counter >= maxsteps
error("Did not converge in ", string(maxsteps), " steps")
else
xnew, counter
end
end

4
Task/Roots-of-a-function/Julia/roots-of-a-function-3.julia Normal file
View file

@ -0,0 +1,4 @@
f(x) = x^3 - 3*x^2 + 2*x
fp(x) = 3*x^2-6*x+2
x_s, count = newton(f,fp,1.00)

50
Task/Roots-of-a-function/Kotlin/roots-of-a-function.kotlin Normal file
View file

@ -0,0 +1,50 @@
// version 1.1.2
typealias DoubleToDouble = (Double) -> Double
fun f(x: Double) = x * x * x - 3.0 * x * x + 2.0 * x
fun secant(x1: Double, x2: Double, f: DoubleToDouble): Double {
val e = 1.0e-12
val limit = 50
var xa = x1
var xb = x2
var fa = f(xa)
var i = 0
while (i++ < limit) {
var fb = f(xb)
val d = (xb - xa) / (fb - fa) * fb
if (Math.abs(d) < e) break
xa = xb
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>) {
val step = 1.0e-2
val e = 1.0e-12
var x = -1.032
var s = f(x) > 0.0
while (x < 3.0) {
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
}
}

30
Task/Roots-of-a-function/Lambdatalk/roots-of-a-function.lambdatalk Normal file
View file

@ -0,0 +1,30 @@
1) defining the function:
{def func {lambda {:x} {+ {* 1 :x :x :x} {* -3 :x :x} {* 2 :x}}}}
-> func
2) printing roots:
{S.map {lambda {:x}
{if {< {abs {func :x}} 0.0001}
then {br}- a root found at :x else}}
{S.serie -1 3 0.01}}
->
- a root found at 7.528699885739343e-16
- a root found at 1.0000000000000013
- a root found at 2.000000000000002
3) printing the roots of the "sin" function between -720° to +720°;
{S.map {lambda {:x}
{if {< {abs {sin {* {/ {PI} 180} :x}}} 0.01}
then {br}- a root found at :x° else}}
{S.serie -720 +720 10}}
->
- a root found at -720°
- a root found at -540°
- a root found at -360°
- a root found at -180°
- a root found at 0°
- a root found at 180°
- a root found at 360°
- a root found at 540°
- a root found at 720°

46
Task/Roots-of-a-function/Liberty-BASIC/roots-of-a-function.basic Normal file
View file

@ -0,0 +1,46 @@
' Finds and output the roots of a given function f(x),
' within a range of x values.
' [RC]Roots of an function
mainwin 80 12
xMin =-1
xMax = 3
y =f( xMin) ' Since Liberty BASIC has an 'eval(' function the fn
' and limits would be better entered via 'input'.
LastY =y
eps =1E-12 ' closeness acceptable
bigH=0.01
print
print " Checking for roots of x^3 -3 *x^2 +2 *x =0 over range -1 to +3"
print
x=xMin: dx = bigH
do
x=x+dx
y = f(x)
'print x, dx, y
if y*LastY <0 then 'there is a root, should drill deeper
if dx < eps then 'we are close enough
print " Just crossed axis, solution f( x) ="; y; " at x ="; using( "#.#####", x)
LastY = y
dx = bigH 'after closing on root, continue with big step
else
x=x-dx 'step back
dx = dx/10 'repeat with smaller step
end if
end if
loop while x<xMax
print
print " Finished checking in range specified."
end
function f( x)
f =x^3 -3 *x^2 +2 *x
end function

30
Task/Roots-of-a-function/Lua/roots-of-a-function-1.lua Normal file
View file

@ -0,0 +1,30 @@
-- Function to have roots found
function f (x) return x^3 - 3*x^2 + 2*x end
-- Find roots of f within x=[start, stop] or approximations thereof
function root (f, start, stop, step)
local roots, x, sign, foundExact, value = {}, start, f(start) > 0
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
-- Main procedure
print("Root (to 12DP)\tMax. Error\n")
for _, r in pairs(root(f, -1, 3, 10^-6)) do
print(string.format("%0.12f", r.val), r.err)
end

5
Task/Roots-of-a-function/Lua/roots-of-a-function-2.lua Normal file
View file

@ -0,0 +1,5 @@
-- 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

2
Task/Roots-of-a-function/Maple/roots-of-a-function-1.maple Normal file
View file

@ -0,0 +1,2 @@
f := x^3-3*x^2+2*x;
roots(f,x);

1
Task/Roots-of-a-function/Maple/roots-of-a-function-2.maple Normal file
View file

@ -0,0 +1 @@
[[0, 1], [1, 1], [2, 1]]

1
Task/Roots-of-a-function/Mathematica/roots-of-a-function-1.math Normal file
View file

@ -0,0 +1 @@
Solve[x^3-3*x^2+2*x==0,x]

1
Task/Roots-of-a-function/Mathematica/roots-of-a-function-2.math Normal file
View file

@ -0,0 +1 @@
NSolve[x^3 - 3*x^2 + 2*x , x]

1
Task/Roots-of-a-function/Mathematica/roots-of-a-function-3.math Normal file
View file

@ -0,0 +1 @@
FindRoot[x^3 - 3*x^2 + 2*x , {x, 1.5}]

1
Task/Roots-of-a-function/Mathematica/roots-of-a-function-4.math Normal file
View file

@ -0,0 +1 @@
FindRoot[x^3 - 3*x^2 + 2*x , {x, 1.1}]

1
Task/Roots-of-a-function/Mathematica/roots-of-a-function-5.math Normal file
View file

@ -0,0 +1 @@
FindInstance[x^3 - 3*x^2 + 2*x == 0, x]

1
Task/Roots-of-a-function/Mathematica/roots-of-a-function-6.math Normal file
View file

@ -0,0 +1 @@
Reduce[x^3 - 3*x^2 + 2*x == 0, x]

54
Task/Roots-of-a-function/Maxima/roots-of-a-function.maxima Normal file
View file

@ -0,0 +1,54 @@
e: x^3 - 3*x^2 + 2*x$
/* Number of roots in a real interval, using Sturm sequences */
nroots(e, -10, 10);
3
solve(e, x);
[x=1, x=2, x=0]
/* 'solve sets the system variable 'multiplicities */
solve(x^4 - 2*x^3 + 2*x - 1, x);
[x=-1, x=1]
multiplicities;
[1, 3]
/* Rational approximation of roots using Sturm sequences and bisection */
realroots(e);
[x=1, x=2, x=0]
/* 'realroots also sets the system variable 'multiplicities */
multiplicities;
[1, 1, 1]
/* Numerical root using Brent's method (here with another equation) */
find_root(sin(t) - 1/2, t, 0, %pi/2);
0.5235987755983
fpprec: 60$
bf_find_root(sin(t) - 1/2, t, 0, %pi/2);
5.23598775598298873077107230546583814032861566562517636829158b-1
/* Numerical root using Newton's method */
load(newton1)$
newton(e, x, 1.1, 1e-6);
1.000000017531147
/* For polynomials, Jenkins–Traub algorithm */
allroots(x^3 + x + 1);
[x=1.161541399997252*%i+0.34116390191401,
x=0.34116390191401-1.161541399997252*%i,
x=-0.68232780382802]
bfallroots(x^3 + x + 1);
[x=1.16154139999725193608791768724717407484314725802151429063617b0*%i + 3.41163901914009663684741869855524128445594290948999288901864b-1,
x=3.41163901914009663684741869855524128445594290948999288901864b-1 - 1.16154139999725193608791768724717407484314725802151429063617b0*%i,
x=-6.82327803828019327369483739711048256891188581897998577803729b-1]

22
Task/Roots-of-a-function/Nim/roots-of-a-function.nim Normal file
View file

@ -0,0 +1,22 @@
import math
import strformat
func f(x: float): float = x ^ 3 - 3 * x ^ 2 + 2 * x
var
step = 0.01
start = -1.0
stop = 3.0
sign = f(start) > 0
x = start
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

33
Task/Roots-of-a-function/OCaml/roots-of-a-function.ocaml Normal file
View file

@ -0,0 +1,33 @@
let bracket u v =
((u > 0.0) && (v < 0.0)) || ((u < 0.0) && (v > 0.0));;
let xtol a b = (a = b);; (* or use |a-b| < epsilon *)
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;;
let search lo hi step f =
let rec next x fx =
if x > hi then [] else
let y = x +. step in
let fy = f y in
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);;
let showroot (x,fx) =
Printf.printf "f(%.17f) = %.17f [%s]\n"
x fx (if fx = 0.0 then "exact" else "approx") in
let f x = ((x -. 3.0)*.x +. 2.0)*.x in
List.iter showroot (search (-5.0) 5.0 0.1 f);;

34
Task/Roots-of-a-function/Objeck/roots-of-a-function.objeck Normal file
View file

@ -0,0 +1,34 @@
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);
};
}
}
}

11
Task/Roots-of-a-function/Octave/roots-of-a-function-1.octave Normal file
View file

@ -0,0 +1,11 @@
a = [ 1, -3, 2, 0 ];
r = roots(a);
% let's print it
for i = 1:3
n = polyval(a, r(i));
printf("x%d = %f (%f", i, r(i), n);
if (n != 0.0)
printf(" not");
endif
printf(" exact)\n");
endfor

21
Task/Roots-of-a-function/Octave/roots-of-a-function-2.octave Normal file
View file

@ -0,0 +1,21 @@
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

12
Task/Roots-of-a-function/Oforth/roots-of-a-function.fth Normal file
View file

@ -0,0 +1,12 @@
: 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 * + ;

55
Task/Roots-of-a-function/OoRexx/roots-of-a-function.rexx Normal file
View file

@ -0,0 +1,55 @@
/* 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
qroot: Procedure
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

1
Task/Roots-of-a-function/PARI-GP/roots-of-a-function-1.parigp Normal file
View file

@ -0,0 +1 @@
polroots(x^3-3*x^2+2*x)

1
Task/Roots-of-a-function/PARI-GP/roots-of-a-function-2.parigp Normal file
View file

@ -0,0 +1 @@
polroots(x^3-3*x^2+2*x,1)

3
Task/Roots-of-a-function/PARI-GP/roots-of-a-function-3.parigp Normal file
View file

@ -0,0 +1,3 @@
solve(x=-.5,.5,x^3-3*x^2+2*x)
solve(x=.5,1.5,x^3-3*x^2+2*x)
solve(x=1.5,2.5,x^3-3*x^2+2*x)

19
Task/Roots-of-a-function/PARI-GP/roots-of-a-function-4.parigp Normal file
View file

@ -0,0 +1,19 @@
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)")
)
)
)
)
};
findRoots(x^3-3*x^2+2*x)

46
Task/Roots-of-a-function/PARI-GP/roots-of-a-function-5.parigp Normal file
View file

@ -0,0 +1,46 @@
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)

41
Task/Roots-of-a-function/PL-I/roots-of-a-function.pli Normal file
View file

@ -0,0 +1,41 @@
f: procedure (x) returns (float (18));
declare x float (18);
return (x**3 - 3*x**2 + 2*x );
end f;
declare eps float, (x, y) float (18);
declare dx fixed decimal (15,13);
eps = 1e-12;
do dx = -5.03 to 5 by 0.1;
x = dx;
if sign(f(x)) ^= sign(f(dx+0.1)) then
call locate_root;
end;
locate_root: procedure;
declare (left, mid, right) float (18);
put skip list ('Looking for root in [' || x, x+0.1 || ']' );
left = x; right = dx+0.1;
PUT SKIP LIST (F(LEFT), F(RIGHT) );
if abs(f(left) ) < eps then
do; put skip list ('Found a root at x=', left); return; end;
else if abs(f(right) ) < eps then
do; put skip list ('Found a root at x=', right); return; end;
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;

64
Task/Roots-of-a-function/Pascal/roots-of-a-function.pas Normal file
View file

@ -0,0 +1,64 @@
Program RootsFunction;
var
e, x, step, value: double;
s: boolean;
i, limit: integer;
x1, x2, d: double;
function f(const x: double): double;
begin
f := x*x*x - 3*x*x + 2*x;
end;
begin
x := -1;
step := 1.0e-6;
e := 1.0e-9;
s := (f(x) > 0);
writeln('Version 1: simply stepping x:');
while x < 3.0 do
begin
value := f(x);
if abs(value) < e then
begin
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
if i > limit then
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.

37
Task/Roots-of-a-function/Perl/roots-of-a-function.pl Normal file
View file

@ -0,0 +1,37 @@
sub f
{
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;
# Check for root at start
print "Root found at $start\n" if ( 0 == $value );
for( my $x = $start + $step;
$x <= $stop;
$x += $step )
{
$value = &f($x);
if ( 0 == $value )
{
# 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 );
}

35
Task/Roots-of-a-function/Phix/roots-of-a-function.phix Normal file
View file

@ -0,0 +1,35 @@
(phixonline)-->
<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: #000080;font-style:italic;">--
-- Print approximate roots of f between x=start and x=stop, using
-- sign changes as an indicator that a root has been encountered.
--</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: #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;">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: #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;">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;">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: #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: #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: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #000000;">x</span> <span style="color: #0000FF;">+=</span> <span style="color: #000000;">step</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: #000080;font-style:italic;">-- Smaller steps produce more accurate/precise results in general,
-- but for many functions we'll never get exact roots, either due
-- 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: #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: #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>
<!--

11
Task/Roots-of-a-function/PicoLisp/roots-of-a-function.l Normal file
View file

@ -0,0 +1,11 @@
(de findRoots (F Start Stop Step Eps)
(filter
'((N) (> Eps (abs (F N))))
(range Start Stop Step) ) )
(scl 12)
(mapcar round
(findRoots
'((X) (+ (*/ X X X `(* 1.0 1.0)) (*/ -3 X X 1.0) (* 2 X)))
-1.0 3.0 0.0001 0.00000001 ) )

28
Task/Roots-of-a-function/PureBasic/roots-of-a-function.basic Normal file
View file

@ -0,0 +1,28 @@
Procedure.d f(x.d)
ProcedureReturn x*x*x-3*x*x+2*x
EndProcedure
Procedure main()
OpenConsole()
Define.d StepSize= 0.001
Define.d Start=-1, stop=3
Define.d value=f(start), x=start
Define.i oldsign=Sign(value)
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
main()

23
Task/Roots-of-a-function/Python/roots-of-a-function.py Normal file
View file

@ -0,0 +1,23 @@
f = lambda x: x * x * x - 3 * x * x + 2 * x
step = 0.001 # Smaller step values produce more accurate and precise results
start = -1
stop = 3
sign = f(start) > 0
x = start
while x <= stop:
value = f(x)
if value == 0:
# We hit a root
print "Root found at", x
elif (value > 0) != sign:
# We passed a root
print "Root found near", x
# Update our sign
sign = value > 0
x += step

18
Task/Roots-of-a-function/R/roots-of-a-function.r Normal file
View file

@ -0,0 +1,18 @@
f <- function(x) x^3 -3*x^2 + 2*x
findroots <- function(f, begin, end, tol = 1e-20, step = 0.001) {
se <- ifelse(sign(f(begin))==0, 1, sign(f(begin)))
x <- begin
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
}
}
findroots(f, -1, 3)

18
Task/Roots-of-a-function/REXX/roots-of-a-function-1.rexx Normal file
View file

@ -0,0 +1,18 @@
/*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 } */

14
Task/Roots-of-a-function/REXX/roots-of-a-function-2.rexx Normal file
View file

@ -0,0 +1,14 @@
/*REXX program finds the roots of a specific function: x^3 - 3*x^2 + 2*x via bisection*/
parse arg bot top inc . /*obtain optional arguments from the CL*/
if bot=='' | bot=="," then bot= -5 /*Not specified? Then use the default.*/
if top=='' | top=="," then top= +5 /* " " " " " " */
if inc=='' | inc=="," then inc= .0001 /* " " " " " " */
x= bot - inc /*compute 1st value to start compares. */
z= x * (x * (x-3) + 2) /*formula used ──► x^3 - 3x^2 + 2x */
!= sign(z) /*obtain the sign of the initial value.*/
do x=bot to top by inc /*traipse through the specified range. */
z= x * (x * (x-3) + 2); $= sign(z) /*compute new value; obtain the sign. */
if z=0 then say 'found an exact root at' x/1
else if !\==$ then if !\==0 then say 'passed a root at' x/1
!= $ /*use the new sign for the next compare*/
end /*x*/ /*dividing by unity normalizes X [↑] */

8
Task/Roots-of-a-function/RLaB/roots-of-a-function.rlab Normal file
View file

@ -0,0 +1,8 @@
f = function(x)
{
rval = x .^ 3 - 3 * x .^ 2 + 2 * x;
return rval;
};
>> findroot(f, , [-5,5])
0

39
Task/Roots-of-a-function/Racket/roots-of-a-function-1.rkt Normal file
View file

@ -0,0 +1,39 @@
#lang racket
;; Attempts to find all roots of a real-valued function f
;; 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)))
;; Finds a root of a real-valued function f
;; 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))]))
;; Returns #t if x is a root of a real-valued function f
;; with absolute accuracy (tolerance).
(define (root? f x) (almost-equal? 0 (f x)))
;; Returns #t if interval (a b) contains a root
;; (or the odd number of roots) of a real-valued function f.
(define (includes-root? f a b) (< (* (f a) (f b)) 0))
;; Returns #t if a and b are equal with respect to
;; the relative accuracy (tolerance).
(define (almost-equal? a b)
(or (< (abs (+ b a)) (tolerance))
(< (abs (/ (- b a) (+ b a))) (tolerance))))
(define tolerance (make-parameter 5e-16))

17
Task/Roots-of-a-function/Racket/roots-of-a-function-2.rkt Normal file
View file

@ -0,0 +1,17 @@
(define (secant f a b)
(let next ([x1 a] [y1 (f a)] [x2 b] [y2 (f b)] [n 50])
(define x3 (/ (- (* x1 y2) (* x2 y1)) (- y2 y1)))
(cond
; if the method din't converge within given interval
; switch to more robust bisection method
[(or (not (< a x3 b)) (zero? n)) (bisection f a b)]
[(almost-equal? x3 x2) x3]
[else (next x2 y2 x3 (f x3) (sub1 n))])))
(define (bisection f x1 x2)
(let divide ([a x1] [b x2])
(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)))))))

8
Task/Roots-of-a-function/Racket/roots-of-a-function-3.rkt Normal file
View file

@ -0,0 +1,8 @@
-> (find-root (λ (x) (- 2. (* x x))) 1 2)
1.414213562373095
-> (sqrt 2)
1.4142135623730951
-> (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)

7
Task/Roots-of-a-function/Racket/roots-of-a-function-4.rkt Normal file
View file

@ -0,0 +1,7 @@
(define (memoized f)
(define tbl (make-hash))
(λ x
(cond [(hash-ref tbl x #f) => values]
[else (define res (apply f x))
(hash-set! tbl x res)
res])))

2
Task/Roots-of-a-function/Racket/roots-of-a-function-5.rkt Normal file
View file

@ -0,0 +1,2 @@
-> (find-roots (memoized f) -3 4 #:divisions 50)
'(2.4932181969624796e-33 1.0 2.0)

19
Task/Roots-of-a-function/Raku/roots-of-a-function.raku Normal file
View file

@ -0,0 +1,19 @@
sub f(\x) { x³ - 3*x² + 2*x }
my $start = -1;
my $stop = 3;
my $step = 0.001;
for $start, * + $step ... $stop -> $x {
state $sign = 0;
given f($x) {
my $next = .sign;
when 0.0 {
say "Root found at $x";
}
when $sign and $next != $sign {
say "Root found near $x";
}
NEXT $sign = $next;
}
}

21
Task/Roots-of-a-function/Ring/roots-of-a-function.ring Normal file
View file

@ -0,0 +1,21 @@
load "stdlib.ring"
function = "return pow(x,3)-3*pow(x,2)+2*x"
rangemin = -1
rangemax = 3
stepsize = 0.001
accuracy = 0.1
roots(function, rangemin, rangemax, stepsize, accuracy)
func roots funct, min, max, inc, eps
oldsign = 0
for x = min to max step inc
num = sign(eval(funct))
if num = 0
see "root found at x = " + x + nl
num = -oldsign
else if num != oldsign and oldsign != 0
if inc < eps
see "root found near x = " + x + nl
else roots(funct, x-inc, x+inc/8, inc/8, eps) ok ok ok
oldsign = num
next

19
Task/Roots-of-a-function/Ruby/roots-of-a-function-1.rb Normal file
View file

@ -0,0 +1,19 @@
def sign(x)
x <=> 0
end
def find_roots(f, range, step=0.001)
sign = sign(f[range.begin])
range.step(step) do |x|
value = f[x]
if value == 0
puts "Root found at #{x}"
elsif sign(value) == -sign
puts "Root found between #{x-step} and #{x}"
end
sign = sign(value)
end
end
f = lambda { |x| x**3 - 3*x**2 + 2*x }
find_roots(f, -1..3)

19
Task/Roots-of-a-function/Ruby/roots-of-a-function-2.rb Normal file
View file

@ -0,0 +1,19 @@
class Numeric
def sign
self <=> 0
end
end
def find_roots(range, step = 1e-3)
range.step( step ).inject( yield(range.begin).sign ) do |sign, x|
value = yield(x)
if value == 0
puts "Root found at #{x}"
elsif value.sign == -sign
puts "Root found between #{x-step} and #{x}"
end
value.sign
end
end
find_roots(-1..3) { |x| x**3 - 3*x**2 + 2*x }

10
Task/Roots-of-a-function/Rust/roots-of-a-function-1.rust Normal file
View file

@ -0,0 +1,10 @@
// 202100315 Rust programming solution
use roots::find_roots_cubic;
fn main() {
let roots = find_roots_cubic(1f32, -3f32, 2f32, 0f32);
println!("Result : {:?}", roots);
}

Some files were not shown because too many files have changed in this diff Show more