1
$\begingroup$

Help me please.

My task is to determine the sequence of polynomials $(s,s',..,-rem(fs_{k-1},s_{k}),...,constant)$ and create an array in which I will record the value of the members of this sequence at two points $({{s[a],s[b]},{s'[a],s'[b]},...}$ .

I define polynomial $s[x]$ and then I want to calculate derivative $s[x]$ as function, but I have no idea, how I can do this:

s[x_]:=x^4-5*x^2-2*x+5
s1[x_]:=D[s[x],x]  

it is wrong, because in this way I will differentiate by constant. And if I will have $s[x]$ and $s1[x]$, I can recursively determine the sequence:

a[x_]:= s[x]
b[x_]:= s1[x]
h[x_]:= -PolynomialRemainder[s[x], s1[x], x];

I have a similar problem in this step, because $h[x]$ isn't function.

Next, I want to recursively determine the sequence and record the value of polynomials at two points at each step (until the function becomes constant).

values = {};
a1 = 0;
a2 = 1;
While[\[Not] TrueQ[D[h[x], x] == 0],a[x_]:= b[x];  b[x_]:=h[x]; 
h[x] = -PolynomialRemainder[a[x], b[x], x]; AppendTo[values, {h[a1],h[a2]}];]]

but expectedly the program is working incorrectly.

I will be grateful for any help.

UPD1:

s[x_] := x^3 - 5*x^2 - 2 x + 2;
ClearAll[s1]; s1[x_] := s'[x];
$\endgroup$
  • 1
    $\begingroup$ define s1 as ClearAll[s1]; s1[x_] := D[s[t], t] /. t -> x? $\endgroup$ – kglr Jun 10 at 18:59
  • $\begingroup$ @kglr Thank you! $\endgroup$ – GThompson Jun 10 at 19:06
  • 2
    $\begingroup$ ... or use ClearAll[s1]; s1[x_] := s'[x] $\endgroup$ – kglr Jun 10 at 19:39
  • $\begingroup$ I'm confused about your desired sequence - what are a and b in the second round? Is it a=h and b=h'? Or a=s' and b=h, as seems to be indicated in your While loop? $\endgroup$ – MelaGo Jun 11 at 3:31
1
$\begingroup$

A possible approach is to use NestWhileList as follows:

ClearAll[s, prem, nwl]
s[x_] := x^4-5*x^2-2*x+5
prem[a_, b_, x_] := -PolynomialRemainder[a, b, x] 
nwl[f_, maxsteps_] := Most @ 
   NestWhileList[{#[[3]], D[#[[3]], x], prem[#[[1]], #[[2]], x]} &, 
    {f[x], f'[x], prem[f[x], f'[x], x]},  
    Not[PossibleZeroQ[#[[2]]]] &, 1, maxsteps]

nwl[s, 10]

{{5 - 2 x - 5 x^2 + x^4, -2 - 10 x + 4 x^3, -5 + (3 x)/2 + (5 x^2)/ 2}, {-5 + (3 x)/2 + (5 x^2)/2, 3/2 + 5 x, -5 + (3 x)/2 + (5 x^2)/2}, {-5 + (3 x)/2 + (5 x^2)/2, 3/2 + 5 x, 209/40}}

Flatten @ nwl[s, 10]

{5 - 2 x - 5 x^2 + x^4, -2 - 10 x + 4 x^3, -5 + (3 x)/2 + (5 x^2)/ 2, -5 + (3 x)/2 + (5 x^2)/2, 3/2 + 5 x, -5 + (3 x)/2 + (5 x^2)/2, -5 + (3 x)/2 + (5 x^2)/2, 3/2 + 5 x, 209/40}

Evaluating each entry at a1 and a2 and reorganizing the resulting list:

a1 = 0; a2 = 1;
Riffle @@ (Flatten@nwl[s, 10] /. {{x -> a1}, {x -> a2}})

{5, -1, -2, -8, -5, -1, -5, -1, 3/2, 13/2, -5, -1, -5, -1, 3/2, 13/2, 209/40, 209/40}

$\endgroup$
1
$\begingroup$

Your approach basically makes sense.

s[x_] := x^4 - 5*x^2 - 2*x + 5
s1[f_] := D[f, x] 
h[f1_, f2_, x_] := -PolynomialRemainder[f1, f2, x]

values = {};
a1 = 0;
a2 = 1;
a = s[x];
b = s1[s[x]];
done = False;

While[! done,
 pr = h[a, b, x];
 AppendTo[values, {a, b, pr} /. x -> {a1, a2}];
 a = pr;
 b = s1[a];
 If[D[pr, x] == 0, done = True];
]

values

{{{5, -1}, {-2, -8}, {-5, -1}}, {{-5, -1}, {3/2, 13/2}, 209/40}}

I'm not sure I understood the definition of the sequence - if it's not right, it should be easy to fix by changing the assignments of a and b inside the While loop.

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.