2
$\begingroup$

I have a set of normal vectors along a curve and want to calculate the curvature at each point. I'm not sure how to do this. Thank you in advance for your help :)

enter image description here

$\endgroup$
2
  • 1
    $\begingroup$ Hi ForeverHopeful and welcome to Mma.SE! Your question needs more from your side. Here it's considered helpful and polite to show your own efforts and share your data and code attempts in a well formatted form, so we can quickly see the problem you are facing. Please help us to help you and edit your question accordingly. Please explain better what is that you have. Numeric or analytic? Also, please take the tour, it will help you understand the site. If you write an excellent question it will inspire great answers. $\endgroup$
    – rhermans
    Jun 18, 2018 at 17:06
  • 3
    $\begingroup$ You could use the formula $|\kappa| = \|d{\bf n}/ds\|$. Some code/data to play with would make it easier for folks to show you how to code it. $\endgroup$
    – Michael E2
    Jun 18, 2018 at 17:21

2 Answers 2

5
$\begingroup$

You can use FrenetSerretSystem combined with Interpolation (using only the first parts of the input data and ignoring the part corresponding to the normals) as follows:

ClearAll[curvature, f, if]
curvature[f_, t_] := First@First@FrenetSerretSystem[{t, f[t]}, t]

Using data with a structure similar to the one in Michael E2's answer:

f = Sin;
data = Table[{{x, f[x]}, Normalize@Cross@{1, f'[x]}}, {x, 0., 6., 0.1}];
arrows = Graphics[{Red, Arrowheads[.025], Arrow[{#, # + #2}] & @@@ data}]; 

if = Interpolation[data[[All, 1]]];
Show[ParametricPlot[Evaluate @ {{t, if[t]}, {t, curvature[if, t] }}, {t, 0, 2 Pi}],
  arrows, PlotRange -> All] 

enter image description here

Using f = # Sin[Cos@#]&, we get

enter image description here

$\endgroup$
4
$\begingroup$

Aw heck, here's a first-order forward difference approximation to the derivative, with unit normal vectors generated from a sine graph. The curvature kappa is shown in gold.

data = Table[{{x, Sin[x]}, Normalize@Cross@{1, Cos[x]}}, {x, 0., 6., 0.1}];

kappa = Ratios /@ 
    MapAt[Norm, Differences@MapAt[Apply[ArcTan], data, {All, 2}], {All, 1}] // 
   Flatten;
Graphics[{
  Thick,
  {ColorData[97][1], Line[data[[All, 1]]]},
  Arrow[{#, # + #2}] & @@@ data,
  {ColorData[97][2], Line@Transpose@{MovingAverage[data[[All, 1, 1]], 2], kappa}}
  }, Frame -> True, Axes -> True]

Mathematica graphics

And here's a second-order central difference approximation to the derivative, which doesn't look a lot different from the above graphics:

kappa = Ratios /@ 
    MapAt[Norm, 
     Differences[MapAt[Apply[ArcTan], data, {All, 2}], 1, 2], {All, 1}] //
   Flatten;
Graphics[{
  Thick,
  {ColorData[97][1], Line[data[[All, 1]]]},
  Arrow[{#, # + #2}] & @@@ data,
  {ColorData[97][2], Line@Transpose@{data[[2 ;; -2, 1, 1]], kappa}}
  }, Frame -> True, Axes -> True]
$\endgroup$

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.