Re: Function to solve polynomial
- To: mathgroup at smc.vnet.net
- Subject: [mg71251] Re: Function to solve polynomial
- From: "dimitris" <dimmechan at yahoo.com>
- Date: Sun, 12 Nov 2006 06:47:32 -0500 (EST)
- References: <ej42av$r0u$1@smc.vnet.net>
Why you don't want to use the built in functions? As regards you solution I think you want to use the sample points of Plot. Anyway here is a user defined function that use the points of the Plot function. But I mention that it is preferable to use Solve and NSolve here since you deal with a polynomial fuction! First we will see the immediate steps of the routine and after we collect the steps to define the function (*I have converted everything in InputForm) Off[General::spell1] (*Initialization Cell*) f[x_] := (x - 4)*(x + 2)*(x - 1)*(x + 5)*(x - 7) (*your function*) plot = Plot[f[x], {x, -10, 10}, DisplayFunction -> Identity]; (*a plot of your function*) 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*) {{15},{45},{75},{105},{133}} samples = Extract[Partition[points[[All,1]], 2, 1], seeds] (*between this points in x axis there is a change in sign of f[x]) {{-5.05272770135449, -4.849437338398854}, {-2.180144395814093, -1.9631516192595024}, {0.7731220173928826, 1.1920904288822671}, {3.7479748978290406, 4.137090696764887}, {6.820031559876605, 7.036278769183953}} (FindRoot[f[x] == 0, {x, #1[[1]], #1[[2]]}] & ) /@ samples (*use these points as initial guesses for the FindRoot algorithm-secant method*) {{x -> -5.}, {x -> -2.}, {x -> 1.}, {x -> 4.}, {x -> 6.999999999998611}} 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},8]; 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}]] Your function f[x_] := (x - 4)*(x + 2)*(x - 1)*(x + 5)*(x - 7) sols = FindAllCrossings1D[f[x], {x, -10, 10}] {-5., -2., 1., 4., 6.999999999998611} 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}] {-5., -2., 1., 4., 6.999999999999992} 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... http://groups.google.com/group/comp.soft-sys.math.mathematica/browse_thread/thread/f042e78929ddb078/0a9c893ced104f6f?lnk=st&q=FindRoot&rnum=3#0a9c893ced104f6f http://groups.google.com/group/comp.soft-sys.math.mathematica/browse_thread/thread/2587d839a40223bb/1a2c1c290d3c4b26?lnk=gst&q=FindRoot+David+Park&rnum=1#1a2c1c290d3c4b26 http://groups.google.com/group/comp.soft-sys.math.mathematica/browse_thread/thread/9836d5644ef5b0a1/49569b37ba055a99?lnk=gst&q=FindRoot&rnum=7#49569b37ba055a99 http://groups.google.com/group/comp.soft-sys.math.mathematica/browse_thread/thread/7612c1825cd938da/f5c53fdd2c7b737e?lnk=gst&q=Find+crossings&rnum=3#f5c53fdd2c7b737e 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 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.