# Appending functions to list

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];
• define s1 as ClearAll[s1]; s1[x_] := D[s[t], t] /. t -> x? – kglr Jun 10 at 18:59
• @kglr Thank you! – GThompson Jun 10 at 19:06
• ... or use ClearAll[s1]; s1[x_] := s'[x] – kglr Jun 10 at 19:39
• 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? – MelaGo Jun 11 at 3:31

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}

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.