Services & ResourcesWolfram ForumsMathGroup Archive

[Date Index] [Thread Index] [Author Index]

Re: Function to solve polynomial

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

Because you face problems with my previous posts here I repost again my
reply with more material.
Just copy/paste ain notebook, select the cell and execute it.

(*initialization cell*)
Off[General::spell1]

(*the steps of the code*)
f[x_] := (x - 4)*(x + 2)*(x - 1)*(x + 5)*(x - 7)
plot = Plot[f[x], {x, -10, 10}, DisplayFunction -> Identity];
Print[StyleForm["the points used by the Plot function ", FontColor ->
Blue]];
points = Cases[plot, {(x_)?NumberQ, (y_)?NumberQ}, Infinity]
 Print[StyleForm["find where the function changes sign", FontColor ->
Blue]];
seeds = Position[Times @@@ Partition[points[[All, 2]], 2, 1], x_ /; x
<= 0]
Print[StyleForm["between this points in x axis there is a change in
sign of  f[x]", FontColor -> Blue]];
samples = Extract[Partition[points[[All, 1]], 2, 1], seeds]
Print[StyleForm["the roots, at last!", FontColor -> Blue]];
(FindRoot[f[x] == 0, {x, #1[[1]], #1[[2]]}] & ) /@ samples

(*the code*)
Clear[f]
FindAllCrossings1D[f_, {x, a_, b_}, opts___] := Block[{
    plotData}, plotData = Cases[Plot[f, {x, a, b}, DisplayFunction -> \
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}]]

(*an example*)
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];

(*another code*)
Clear[f]
Needs["NumericalMath`IntervalRoots`"]
FindAllCrossingsInt[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}]]

(*an example*)
 f[x_] := (x - 4)*(x + 2)*(x - 1)*(x + 5)*(x - 7)
sols = x /. FindAllCrossingsInt[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}];

(*another example*)

(*another example*)
g[x_] := 5*(x/100) + Cos[x]
sols = FindAllCrossings1D[g[x], {x, -30, 30}]
plotFunctionRoots[g[x], {x, -30, 30}, sols];
sols = x /. FindAllCrossingsInt[g[x], {
      x, -30, 30}, {0.1, MaxRecursion -> 10}]
plotFunctionRoots[g[x], {x, -30, 30}, sols,
    ImageSize -> {400, 300}, Frame -> {True,
    True, False, False}, Axes -> {True, False}];
plotFunctionRoots[g[x], {x, -20, -18}, sols,
        ImageSize -> {400, 300}, Frame -> {True, True,
False, False}, Axes -> {True, False}, PlotLabel -> "zoom in"];




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.

• Follow-Ups:
  • Re: Re: Function to solve polynomial
    • From: Murray Eisenberg <murray@math.umass.edu>