1
$\begingroup$

I have a data set with $(x,y)$ coordinates. I do the following to import the data

data = Import[
   "plot.txt", "Table"];
x = data[[All, 2]]-250;
y = data[[All, 1]];
Newdata = Transpose[{x, y}];
p2 = ListPlot[Newdata, PlotRange -> {{0, 200}, {34, 36}}, 
  PlotStyle -> Red]

And I obtain the following plot enter image description here

Edit: This is my attempt

intp = Interpolation[Transpose[{x, y}]];
d1[t_] := D[{s, intp[s]}, s] /. s -> t;
d2[t_] := D[{s, intp[s]}, {s, 2}] /. s -> t;
k[t_] := Det[{d1[t], d2[t]}]/Norm[d1[t]]^3;
(*find the min and max curvature so we can scale the colours*)

maxk = First[NMaximize[{k[t], 0 < t < Max[data[[All, 1]]]}, t]];
mink = First[NMinimize[{k[t], 0 < t < Max[data[[All, 1]]]}, t]];
Plot[intp[t], {t, 0, 1}, PlotStyle -> Thick, PlotRange -> All, 
 ColorFunction -> Function[{t}, Hue[Rescale[k[t], {mink, maxk}]]]]

I get the following error

Interpolation:The point 14 in dimension 1 is duplicated.

enter image description here

Now, I would like to know why I get such an error while calculating the variation of the mean curvature along the $x$-axis. Can anyone suggest how to approach that?

$\endgroup$
2
  • $\begingroup$ There are many ways to describe curvature. Which one do you want? $\endgroup$
    – flinty
    Commented Jun 16, 2020 at 13:10
  • $\begingroup$ Wouldn't you first need to have a model of the function underlying your data? $\endgroup$
    – DavidC
    Commented Jun 16, 2020 at 13:19

1 Answer 1

2
$\begingroup$
data = Table[{x, Tanh[6 x] Exp[-x/2]}, {x, 0, 1, .01}];
intp = Interpolation[data];

d1[t_] := D[{s, intp[s]}, s] /. s -> t;
d2[t_] := D[{s, intp[s]}, {s, 2}] /. s -> t;
k[t_] := Det[{d1[t], d2[t]}]/Norm[d1[t]]^3

(* find the min and max curvature so we can scale the colours *)
maxk = First[NMaximize[{k[t], 0 < t < Max[data[[All, 1]]]}, t]];
mink = First[NMinimize[{k[t], 0 < t < Max[data[[All, 1]]]}, t]];
Plot[intp[t], {t, 0, 1}, PlotStyle -> Thick, PlotRange -> All, 
 ColorFunction -> Function[{t}, Hue[Rescale[k[t], {mink, maxk}]]]]

plot with curvature

There's also a much simpler way to get curvature using ArcCurvature:

k[t_] := ArcCurvature[intp[s], s] /. s -> t
maxk = First[NMaximize[{k[t], 0 < t < Max[data[[All, 1]]]}, t]];
mink = First[NMinimize[{k[t], 0 < t < Max[data[[All, 1]]]}, t]];
Plot[intp[t], {t, 0, 1}, PlotStyle -> Thick, PlotRange -> All, 
 ColorFunction -> Function[{t}, Hue[Rescale[k[t], {mink, maxk}]]]]
$\endgroup$
9
  • $\begingroup$ as In order to import the data ..I do ArcCurvature[x, y] /. y -> t ? $\endgroup$
    – newstudent
    Commented Jun 16, 2020 at 14:05
  • $\begingroup$ No, you need to interpolate the data first. In your case: intp = Interpolate[Transpose[{x, y}]] or just replace data at the top of my code with Transpose[{x, y}] $\endgroup$
    – flinty
    Commented Jun 16, 2020 at 14:10
  • $\begingroup$ Did this solve your problem? $\endgroup$
    – flinty
    Commented Jun 16, 2020 at 15:48
  • $\begingroup$ No. I get an error The value function is not number from both the approaches. $\endgroup$
    – newstudent
    Commented Jun 17, 2020 at 7:13
  • $\begingroup$ @newstudent please add an update to your question with what you tried. It might help diagnose the issue. $\endgroup$
    – flinty
    Commented Jun 17, 2020 at 12:33

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.