Creating a function with integral zeroes of the 0th, 1st, and 2nd derivatives

Question

I would like to be able to randomly generate functions, each of which satisfies

1. $f : [-10, 10] \rightarrow [-10, 10]$

2. All the zeroes, critical points, and inflection points have an integral $x$-value

3. Some of the critical points -- $x$-values where $f'(x) = 0$ -- are local extrema, but some aren't

4. Some of the zeroes are also at local extrema (like $x=0$ in the function $y=x^2$), and some aren't

It's easy to draw such a function by hand and then define a piecewise function that looks similar. The hard part, for me, is finding an algorithm that generates these functions with some randomness. I was approaching this by taking functions of the form $y=a (x-b)^2 + c$ and gluing them together so that the points and derivatives match up. (If the second derivatives don't match up, that's ok -- my Mathematica method will still identify the "gluing" points as inflection points.) This works fine if I'm only worried about critical points and inflection points, but seems to become very difficult when trying to respect the zeroes condition.

Can anyone think of a tractable algorithm for this?

EDIT: the randomness needs to be present beyond just, say, a scalar multiple. The goal is to show graphs of these functions to students and ask them to visually identify zeros / critical points / inflection points, and so different functions should correspond to usefully-different problems.

Answer 1

Numerically doing one can easily use inbuilt Interpolation as follows.

(* Random number of zeros, critical points and infliction and where they occur *)
{zeros, crit, inflic} =Union /@(RandomInteger[{-10, 10}, #] & /@ RandomInteger[{1, 5}, 3]);
(* Gather the conditions as per the point of occurrence *)
rules = GatherBy[Flatten@
MapThread[Thread[Rule[#1, #2]] &,{{zeros, crit, inflic}, Range[0, 2]}],First];
args = DeleteDuplicates /@ rules[[All, All, 1]];
(* random value of the function, limit of values of 1st derivative, similar limit for 2nd *)
random[] := {RandomInteger[{-10, 10}], RandomInteger[{-1, 1}],RandomInteger[{-1, 1}]};
(* apply the above generated conditions *)
vals = With[{val = #}, 
     ReplacePart[random[], (# -> 0) & /@ val]] & /@ (1 + rules[[All, All, 2]]);
rest = ({{#}}~Join~random[]) & /@ (Complement[Range[-10, 10, 1],args // Flatten]);
(* create values for left over integer points in [-10,10] and interpolate *)
fun = Interpolation[SortBy[Join[rest, MapThread[Join[{#1}, #2] &,{args, vals}]],First],
      InterpolationOrder -> 3];

Now we can see the order of derivative conditions to be fulfilled at the random integral points on $[-10,10]$.

randAtrributes =SortBy[Thread@Rule[Flatten@args, rules[[All, All, 2]]], First]

{-9 -> {2}, -8 -> {0, 2}, -7 -> {2}, -6 -> {1}, -5 -> {0}, -1 -> {0}, 4 -> {1}, 5 -> {1}, 7 -> {1}, 8 -> {2}}

Now we see the randomly generated conditions

expr = MapAt[D[f[x] == 0, {x, #}] &,randAtrributes[[All, 2]], {All, All}]

{{(f^[Prime][Prime])[x] == 0}, {f[x] == 0, (f^[Prime][Prime])[x] == 0}, {(f^[Prime][Prime])[x] == 0}, {Derivative1[f][x] == 0}, {f[x] == 0}, {f[x] == 0}, {Derivative1[f][x] == 0}, {Derivative1[f][x] == 0}, {Derivative1[f][x] == 0}, {(f^[Prime][Prime])[x] == 0}}

Above interpolating function fulfills the conditions

MapThread[#2 /. x -> #1 /. f -> fun &, {randAtrributes[[All, 1]], expr}]

{{True}, {True,True}, {True}, {True}, {True}, {True}, {True}, {True}, {True}, {True}}

Now some plot for visual check!

Plot code:

pt = randAtrributes[[All, 1]];
Plot[fun[x], {x, -10, 10}, PlotRange -> {{-12, 13}, {-12, 12}}, 
 Frame -> True, Axes -> {False, True}, 
 AxesStyle -> {None, Directive[Dashed, Black]}, 
 Epilog -> {{Dashed, Thin, Opacity[.7], Gray, 
    Line[{{#, 0}, {#, fun[#]}, {0, fun[#]}}] & /@ pt}, {Red, 
    PointSize[0.01], Point[{#, fun[#]}] & /@ pt}, 
   Flatten@MapThread[{pos = {#2 + RandomReal[{.5, 1}], 
         fun[#2] + RandomReal[{.5, 2}]}; 
       Inset[Style[Column[TraditionalForm /@ (#1 /. x -> #2)], 
         Magenta], pos, 
        BaseStyle -> {10, FontFamily -> "Calibri", Bold}], Orange, 
       Thin, Dashed, Arrowheads[.015], 
       Arrow[{pos, {#2, fun[#2]}}]} &, {expr, pt}]}]

Answer 2

Here's one way to get started:

spec = RandomInteger[{-9, 9}, 3];
p[x_] := a x^5 + b x^4 + c x^3 + d x^2 + e x + f;
p2[x_] = D[p[x], x];
p3[x_] = D[p2[x], x];
sol = FindInstance[
   p[spec[[1]]] == 0 && p2[spec[[2]]] == 0 && p3[spec[[3]]] == 0 && f > 0, 
   {a, b, c, d, e, f}, Reals];
Plot[(p[x] /. sol)/p[9] /. sol // N, {x, -10, 10}]

This builds a 5th order polynomial and then forces the roots of the polynomial and its derivatives to be random integers. It then uses FindInstance to choose specific values for the coefficients. Each time you run the code, you get a different set of integer points, and hence a different polynomial. Because 5th order polys can get large at x=10, I scaled the final polynomial (by the value at p[9]).

As Szabolcs points out, this ensures that the specified critical points must exist in the polynomial, but there may occur other critical points depending on the vagaries of the solution found by FindInstance. If it is important to have all the critical points lie on integer values, then it would be easy to add a test to see if any extra critical points have appeared -- if so, then try again.

Answer 3

I ended up solving this using the algorithm below. This was rather complicated (which is why I'm only describing the process, and have omitted both the actual code and several small details), so maybe there's a better way.

1) Randomly pick the critical points, with the restriction that their slopes have to have absolute value between 1 and 3, and that their x-coordinates have to be a distance of between 2 and 5 apart.

2) Between each pair of critical points, pick the number of inflection points, and their x-coordinates. Randomly determine y-values based on several constraints.

3) Between each pair of critical points, determine if there is going to be a zero. Find the x-value assuming it's on the line between the two critical points, and then floor or ceiling that x-value depending on several factors.

4) Determine derivative values at each point.

5) Compile all the points together (criticals, inflections, and zeros) so you have a collection of all your x-values, y-values, and derivative values. Join each adjacent pair of points by using FindInstance on the function a/(x+b) + cx + d, with the restriction that the vertical asymptote can't lie in the interval on which this function will be defined. Mathematica handles this easily, and this function is able to join together any two points with any two slopes, without changing concavity. (*The slopes do have to be compatible with a fixed concavity, and there are still occasional restrictions on slope, but this is a small point.)

6) The final result is a piecewise function with all the above FindInstance functions each defined over the interval that was used to generate it.

I'm still tweaking some of the random-generation parameters to make it look a little smoother, but here is one of the earlier curves I randomly generated, and you can see it has all the required properties.