Circle of Curvature

kurve[m_,x_] := Plot[Cos[x] +Cos[m*x],{x,0,16},
AspectRatio -> 1/2,
PlotRange ->{{0,16},{-4,4}}];

y´[m_,x_]  :=D[Cos[x] + Cos[m*x ],x];

y´´[m_,x_]:=D[Cos[x] + Cos[m*x ],{x,2}];

kR[m_,x_]:= 
(1 +(y´[m,x])^2)^(3/2)/y´´[m,x]//Evaluate

xK[m_,x_] :=
 x-y´[m,x]((1+((y´[m,x])^2))/(y´´[m,x]))//Evaluate;

yK[m_,x_] := 
Cos[x ]+ Cos[m*x]   +  ((1+((y´[m,x])^2))/(y´´[m,x]))//Evaluate;

kK[m_,x_] :=
{RGBColor[0.6,0.6,0.8], Disk[{xK[m,x], yK[m,x]},Abs[kR[m,x]]]} ;

Manipulate[
Show[
Graphics[
{RGBColor[0.6,0.6,0.8], Disk[{xK[m,x], yK[m,x]},Abs[kR[m,x]]]}
],
Plot[Cos[x] +Cos[m*x ],{x,0,16}],
Graphics[{PointSize[.025],Point[{x,Cos[x] + Cos[m*x ]}]}],
AspectRatio -> 1/2,
PlotRange ->{{0,16},{-4,4}},
Background -> RGBColor[.85,.999,.999],
Axes ->False,ImageSize->500], 
{{x,7.153, "x coordinate of point"},0,16,.001},
{{m,1.304, "change curve"}, 0, 2 , .005 Pi},SaveDefinitions->True]

THIS NOTEBOOK IS THE SOURCE CODE FROM

"Circle of Curvature" from The Wolfram Demonstrations Project
 http://demonstrations.wolfram.com/CircleOfCurvature/

Contributed by: Herbert W. Franke

A full-function Wolfram Mathematica 6 system is required to edit this notebook.
GET WOLFRAM MATHEMATICA 6 »

© The Wolfram Demonstrations Project & Contributors   |   Terms of Use   |   Make a new version of this Demonstration »