Finding a coefficient that satisfies and intersecting condition

Question

Suppose I have the following polynomial:

GPrPo=354 x + 1143 x^2 + 2320 x^3 + 3811 x^4 + 5441 x^5 + 6403 x^6 + 
 6829 x^7 + 6658 x^8 + 5571 x^9 + 4737 x^10 + 3560 x^11 + 2741 x^12 + 
 2174 x^13 + 1579 x^14 + 1120 x^15 + 789 x^16 + 502 x^17 + 275 x^18 + 
 215 x^19 + 117 x^20 + 59 x^21 + 30 x^22 + 30 x^23 + 21 x^24 + 
 6 x^25 + 4 x^26 + x^27 + 2 x^28 + 3 x^29 + x^30 + 2 x^31

I also define:

GDPrPo = D[GPrPo, x]

Now let us have the following:

k = 6;
u = (3188 x^16)/x^k;
v = (x - x^k) u;
y = 1 + v/GPrPo - x/(382 GPrPo) (GDPrPo + D[v, x]);
Plot[{1, y}, {x, 2/381, 1}, 
 PlotRange -> {{0, 1.001}, {0.9999, 1.00001}}]

Which produces the following plot:

I am interested in the point where the orange curve intersects the line 1. Here I determined the coefficient with hand. Namely in u the coefficient 3188 is the appropriate one to satisfy my condition.

Let me explain the situation. For given k, in this case k=6, we want to find -- for all powers of x namely from x^6 to x^31 (corresponding to the powers of GPrPo) -- the coefficients where the orange lines intersects the line 1.

Another example is:

k = 6;
u = (2615 x^15)/x^k;
v = (x - x^k) u;
y = 1 + v/GPrPo - x/(382 GPrPo) (GDPrPo + D[v, x]);
Plot[{1, y}, {x, 2/381, 1}, 
 PlotRange -> {{0, 1.001}, {0.9999, 1.00001}}] 

as you can see for x^15 the coefficient is ~2615. I wonder how can I have a code which would determine the coefficients in u such that my condition is satisfied.

Answer 1

GPrPo[x_] := 
354 x + 1143 x^2 + 2320 x^3 + 3811 x^4 + 5441 x^5 + 6403 x^6 + 
6829 x^7 + 6658 x^8 + 5571 x^9 + 4737 x^10 + 3560 x^11 + 
2741 x^12 + 2174 x^13 + 1579 x^14 + 1120 x^15 + 789 x^16 + 
502 x^17 + 275 x^18 + 215 x^19 + 117 x^20 + 59 x^21 + 30 x^22 + 
30 x^23 + 21 x^24 + 6 x^25 + 4 x^26 + x^27 + 2 x^28 + 3 x^29 + 
x^30 + 2 x^31

GDPrPo[x_] := D[GPrPo[\[FormalX]], \[FormalX]] /. \[FormalX] -> x

k = 6;
u[x_, c_, n_] := (c x^n)/x^k;
v[x_, c_, n_] := (x - x^k) u[x, c, n];
y[x_, c_, n_] := 1 + v[x, c, n]/GPrPo[x] - 
x/(382 GPrPo[x]) (GDPrPo[x] + D[v[\[FormalX], c, n], \[FormalX]] /. \[FormalX] -> x);

sol[p_] := 
Cases[Reduce[y[x, c, p] >= 1 && c > 0 && 1 > x > 0, {c, x}, Reals], 
And[_Equal, _Equal], \[Infinity]] // NSolve // First

Then use smth. like Table[sol[p],{p,6,31}] to find all values of your coefficient c.