19
$\begingroup$

Through a coordinates list and then interpolating them I got a $f[x]$.

f[x_] = 0.0000476869 x^4 - 0.00924801 x^3 + 0.68087 x^2- 23.0869 x + 322.355;
data = {#, f[#]} & /@ Range[20, 60, 10];
image1 = Plot[f[x], {x, 20, 60},
  Epilog->{Red, PointSize[0.02], Point[data]},
  PlotRange-> {{-5, 70}, {-5, 70}}, AspectRatio -> 1];

I made a change to one of the values of original list coordinates to change the result of the curvature.

newdata = ReplacePart[data, {2, 1} -> 33.5];
Clear[x];
image2 = Fit[newdata, {1, x, x^2, x^3, x^4}, x];
Plot[image2, {x, 20, 60}, 
   Epilog -> {Red, PointSize[0.02], Point[newdata]},
   PlotRange -> {{-5, 70}, {-5, 70}}, AspectRatio -> 1]

Is there anything that allows me to identify the "Inflection point" and show me a "Curvature Plot" for this function?

Here is an example created by SolidWorks:

enter image description here

Teory

Inflexion Point Calculator

Improve this question
$\endgroup$

2 Answers 2

Reset to default
29
$\begingroup$

Let's rename things slightly to make it more consistent

g = Fit[newdata, {1, x, x^2, x^3, x^4}, x];

To find inflection points, you can just put (blue) points where the second derivative is zero.

Plot[g, {x, 20, 60}, 
 Epilog -> {Red, PointSize[0.02], Point[newdata],
   Blue, Point[{x, g} /. Solve[D[g, {x, 2}] == 0]]}, 
 PlotRange -> {{-5, 70}, {-5, 70}}, AspectRatio -> 1]

1

To make a fancier plot we could look up an Evolute. Now the radius of curvature is infinite at an inflection point, so we will actually just use the curvature. We also need a scaling factor to see it on the plot.

ClearAll@evolute;
evolute[{x_, y_}, t_, s_] := 
  {x, y} + s (D[x, t] D[y, {t, 2}] - 
    D[x, {t, 2}] D[y, t])/(D[x, t]^2 + D[y, t]^2)^2 {-D[y, t], D[x, t]}

e = evolute[{x, g}, x, 200];

ParametricPlot[{{x, g}, e}, {x, 20, 60}, PlotStyle -> Thick, 
 Epilog -> {Red, PointSize[0.02], Point[newdata], Blue, Point[{x, g} /. 
   Solve[D[g, {x, 2}] == 0]],
   Blue, Opacity[0.5], Table[Line[{{x, g}, e}], {x, 20, 60, 0.5}]}, 
 PlotRange -> {{-5, 70}, {-5, 70}}, AspectRatio -> 1]

2

gif

Improve this answer
$\endgroup$
6
  • $\begingroup$ If the fitted function had been defined as g[x_] = Fit[newdata, {1, x, x^2, x^3, x^4}, x], then it would have been easier to use MeshFunctions to mark the inflexion points, by then adding the settings Mesh -> {{0.}}, MeshFunctions -> {g''[#] &}, MeshStyle -> Directive[Blue, PointSize[0.02]]. $\endgroup$
    – J. M.'s missing motivation ♦
    Commented Jun 30, 2016 at 23:30
  • $\begingroup$ @J.M. Where these settings should be added? You could add as a answer? $\endgroup$
    – LCarvalho
    Commented Jul 1, 2016 at 13:56
  • $\begingroup$ @Leandro, add them in ParametricPlot[]; those are options for that function. $\endgroup$
    – J. M.'s missing motivation ♦
    Commented Jul 1, 2016 at 14:05
  • $\begingroup$ @wxffles You could, at least, show me a way so that i can generate an animation, as you did, varying the values yielded by this function: e = evolute[{x, g}, x, 200]? $\endgroup$
    – LCarvalho
    Commented Jul 1, 2016 at 14:05
  • $\begingroup$ @LeandroMacieldeCarvalho Export["foo.gif", Table[e = evolute[{x, g}, x, 300 (1 + Cos[a])]; ParametricPlot[...], {a,0,2Pi,2Pi/32}]] $\endgroup$
    – wxffles
    Commented Jul 3, 2016 at 21:37
3
$\begingroup$

You can hard code the curvature and apply it to your image2 and plot it. Then the inflection points are where the curve intersects the horizontal axis. Use the code below after your code. I find that there are two inflection points.

curvature[x_] := D[#, {x, 2}]/Sqrt[1 + D[#, x]^2]^(3/2) &;

k[x_] = curvature[x][image2]

Plot[k[x], {x, 20, 60}]
Improve this answer
$\endgroup$
2
  • $\begingroup$ You can format inline code and code blocks by selecting the code and clicking the {} button above the edit window. The edit window help button ? is also useful for learning how to format your questions and answers. You may also find this meta Q&A helpful $\endgroup$
    – Michael E2
    Commented Jul 1, 2016 at 1:12
  • $\begingroup$ This formula is wrong: there shouldn't be the Sqrt: link. $\endgroup$
    – corey979
    Commented May 14, 2019 at 17:46

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

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