Take the 2-minute tour ×
Mathematica Stack Exchange is a question and answer site for users of Mathematica. It's 100% free, no registration required.

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.

share|improve this question
    
This answer How to find the smallest root could be helpful for gluing functions togeter. However I don't think you have to glue anything, just try to solve a simple system of adequate equations, or simply construct such a class of functions. This is not too difficult, especially when you restrict to univariate polynomials. –  Artes Feb 3 at 22:53
    
Would you be able to give me some specifics on these suggestions? I'm pretty new to MM, and it isn't clear to me how to implement what you're saying. (Also note per my recent edit that there should be a fair amount of visual randomness.) –  Twiffy Feb 3 at 23:13
1  
Yes, I would be able, but my time is precious, so I'm not going provide a full answer. –  Artes Feb 4 at 0:08
2  
I think this is hard to do with polynomials. Even with Interpolation, it's somewhat hard to get every zero, critical point, and inflection point to occur at an integer abscissa. Also randomly generated ones are probably not always going to look good. –  Michael E2 Feb 4 at 5:18
1  
@Artes, that's completely understandable. I can appreciate that this question might not be interesting to you, and I have similar experiences in other venues with people being ungrateful for my assistance, so I can sympathize. But it's also frustrating for me when someone tells me that they have a solution but that they're unwilling to share it. With respect, and perhaps for future reference, I think it would have been kinder to refrain from posting. –  Twiffy Feb 4 at 18:38

3 Answers 3

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! enter image description here

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}]}]
share|improve this answer
1  
Thanks for this! It looks from the code and the plots, though, that some of the critical points and inflection points are integral, but not all. I do need them all to be integral, the zeroes as well, or else the poor student's brains will melt. –  Twiffy Feb 4 at 18:41

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}]

enter image description here

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.

share|improve this answer
1  
The problem with this is that while some zeros and critical points will be integers, some others might not be. –  Szabolcs Feb 4 at 3:52
up vote 1 down vote accepted

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) + c*x + 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.

sample curve

share|improve this answer

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

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