Re: Function to solve polynomial

• To: mathgroup at smc.vnet.net
• Subject: [mg71254] Re: Function to solve polynomial
• From: "dimitris" <dimmechan at yahoo.com>
• Date: Sun, 12 Nov 2006 06:47:36 -0500 (EST)
• References: <ej42av\$r0u\$1@smc.vnet.net>

```Previous mail contain a mistake. Ignore it.

See this post.

Off[General::spell1] (*Initialization Cell*)

f[x_] := (x - 4)*(x + 2)*(x - 1)*(x + 5)*(x - 7)

plot = Plot[f[x], {x, -10, 10},DisplayFunction -> Identity];

points = Cases[plot, {(x_)?NumberQ, (y_)?NumberQ},Infinity];
(*the points used by the Plot function in order to construct \
the plot*)

seeds=Position[Times@@@Partition[points[[All,2]],2,1],x_/;x<=0] (*find
where the function changes sign*)

samples =Extract[Partition[points[[All,1]], 2, 1],seeds] (*between
this points in x axis there is a change in sign of
f[x]*)

(FindRoot[f[x] == 0, {x, #1[[1]], #1[[2]]}] & ) /@ samples
(*use these points as initial guesses for the FindRoot algorithm-
secant method*)

Now the routine

Clear[f]

FindAllCrossings1D[f_,{x,a_,b_},opts___]:=Block[{
plotData},plotData=Cases[Plot[f,{x,
a,b},DisplayFunction\[Rule]Identity],{x_?NumberQ,y_?
NumberQ},Infinity];

x/.FindRoot[f,{x,#[[1]],#[[2]]},opts]&/@(Extract[Partition[plotData[[
All,1]],2,1],Position[Times@@@Partition[plotData[[All,
2]],2,1],x_/;x<=0]])]

plotFunctionRoots[f_, {x_, a_, b_}, roots_, opts___] :=
Block[{ff}, ff = Function[x, Evaluate[f]]; Plot[f, {x, a, b}, opts,
Epilog -> {Red, PointSize[0.02], (Point[{#1, ff[#1]}] & ) /@
roots}]]

f[x_] := (x - 4)*(x + 2)*(x - 1)*(x + 5)*(x - 7)

sols = FindAllCrossings1D[f[x], {x, -10, 10}]

plotFunctionRoots[f[x], {x, -10, 10}, sols];

Here is another routine that makes use of the package
NumericalMath`IntervalRoots`

Clear[f]

Needs["NumericalMath`IntervalRoots`"]

FindAllCrossings3[f_, {x_, a_, b_}, {tol_, opts1___}, opts2___] :=
(FindRoot[f, {x, #1[[1]], #1[[2]]}, opts2] & ) /@
List @@ IntervalBisection[f, x, Interval[{a, b}], tol, opts1]

plotFunctionRoots[f_, {x_, a_, b_}, roots_, opts___] :=
Block[{ff}, ff = Function[x, Evaluate[f]]; Plot[f, {x, a, b}, opts,
Epilog -> {Red, PointSize[0.02], (Point[{#1, ff[#1]}] & ) /@
roots}]]

sols = x /. FindAllCrossings3[f[x], {x, -10, 10}, {0.1, MaxRecursion
->10}]

plotFunctionRoots[f[x], {x, -10, 10}, sols, ImageSize -> {400, 300},
Frame -> {True, True, False, False}, Axes -> {True, False}];

Here are some relevant links inside this forum...

There is also a solution in the following book

http://www.amazon.com/Mathematica-Action-Stan-Wagon/dp/0387986847/sr=1-2/qid=1162830266/ref=sr_1_2/103-5414680-6091022?ie=UTF8&s=books

Regards
Dimitris Anagnostou

a1b2c3d4 wrote:
> I am trying to write a function that will help me solve the polynomial f(x)=(x-4)(x+2)(x-1)(x+5)(x-7) (NSolve and Solve functions not preferred)
>
> I can only think of this function:
> solution := {Plot[{(x -4)(x + 2)(x - 1)(x + 5)(x - 7)}, {x, -10, 10}, AxesLabel -> TraditionalForm /@ {x, y}]}
>
> Does anyone have better knowledge than me in writing an automated program to solve this polynomial? Say For, While or Do Loop?
>
> Your help will be greatly appreciated.

```

• Prev by Date: Re: Re: Re: Simplifying in Mathematica
• Next by Date: Re: are there any methods of figuring out how "large" a piece of typeset textual data will be?
• Previous by thread: Points sampled by N[Derivative[]]
• Next by thread: Re: Function to solve polynomial