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'm trying to build a control selector or menu for equations to put into my curvature simulations. However all the code I've tried hasn't worked.Does anyone know how I could make a control selector or menu for a position vector r[t] in my simulation?

r[t_] := {3 Cos[t], Sin[t]}
uT[t_] := Simplify[r'[t]/Norm[r'[t]], t \[Element] Reals]
vN[t_] := Simplify[uT'[t]/Norm[uT'[t]], t \[Element] Reals]
x[t_] := r[t][[1]]
y[t_] := r[t][[2]]

y2[t_] = r[t] + ((1/(uT[t]/r'[t])) vN[t])

OlcusionPoint[t_] := y2[t][[1]]
(*-((((x'[t])^2+(y'[t])^2)*y'[t])/((x'[t]*y''[t])-(x''[t]*y'[t])))*)
OclusionPoint2[t_] := y2[t][[2]]

(*+((((x'[t])^2+(y'[t])^2)*x'[t])/((x'[t]*y''[t])-(x''[t]*y'[t])))*)
Manipulate[
 Show[Graphics[{RGBColor[0.6, 0.6, 0.8], 
    Disk[{OlcusionPoint[t], OclusionPoint2[t]}, 
     Abs[1/(uT[t]/r'[t])]]}], 
  ParametricPlot[{x[t], y[t]}, {t, 0, 2 Pi}], 
  Graphics[{PointSize[.025], Point[{x[t], y[t]}]}]], {t, 0.0001, 
  2 Pi}]
share|improve this question
    
Neither Selector nor Menu are type of controllers in Mathematica. So what do you want and what do you want it to do? Take a look at ref/ControlObjects –  Kuba May 25 at 7:42
    
I was think either an Action or Popup menu –  user14520 May 25 at 7:59
    
Is this: Manipulate[ Show[Graphics[{RGBColor[0.6, 0.6, 0.8], Disk[{OlcusionPoint[t], OclusionPoint2[t]}, Abs[1/(uT[t]/r'[t])]]}], ParametricPlot[{x[t], y[t]}, {t, 0, 2 Pi}], Graphics[{PointSize[.025], Point[{x[t], y[t]}]}]], {t, 0.0001, 2 Pi}, Row[{ActionMenu["Pos", Rest@Most@Table[With[{t1 = t1}, r[t1] :> (t = t1)], {t1, 0, 2 Pi, 2 Pi/9}]]}] ] what you need? –  Kuba May 25 at 8:05
    
Or:fun = "{x[t],y[t]}"; Manipulate[ Show[Graphics[{RGBColor[0.6, 0.6, 0.8], Disk[{OlcusionPoint[t], OclusionPoint2[t]}, Abs[1/(uT[t]/r'[t])]]}], ParametricPlot[ToExpression@fun, {t, 0, 2 Pi}], Graphics[{PointSize[.025], Point[{x[t], y[t]}]}], ImageSize -> {500, 500}], Column[{ Slider[Dynamic@t, {0.0001, 2 Pi}], PopupMenu[Dynamic@fun, {"{x[t],y[t]}", "{2*x[t],y[t]}"}, FieldSize -> {10, 1}] }], TrackedSymbols -> {t, fun} ] –  eldo May 25 at 8:47

3 Answers 3

Edited

I don't like this much because what I take are intended to be the osculating circles don't have a radius equal to the radius of curvature. I used your formula, but it appears to be wrong.

Nevertheless, what I've worked out does install a popup menu into a Manipulate expression which will select which parametric function will be displayed. It will work with any reasonable number of parametric forms.

Clear[t]; forms = {{3 Cos[t], Sin[t]}, {Cos[t], Sin[2 t]}};
lbls = ToString /@ forms;
indxs = Range[Length[forms]];
rules = Thread[Rule[indxs, lbls]];
(r[t_, #] = forms[[#]]) & /@ indxs;
(dr[t_, #] = D[r[t, #], t]) & /@ indxs;
(uT[t_, #] = Simplify[dr[t, #]/Norm[dr[t, #]], t ∈ Reals]) & /@ indxs;
(vN[t_, #] = Simplify[With[{du = D[uT[t, #], t]}, du/Norm[du]], t ∈ Reals]) & /@ indxs;
(center[t_, #] = r[t, #] + ((1/(uT[t, #]/dr[t, #])) vN[t, #])) & /@ indxs;
(radius[t_, #] = Abs[1/(uT[t, #]/dr[t, #])]) & /@ indxs;

Manipulate[Show[
  Graphics[{RGBColor[0.6, 0.6, 0.8], Disk[center[t, k], radius[t, k]]}],
  ParametricPlot[r[t, k], {t, 0, 2 Pi}],
  Graphics[{PointSize[.025], Point[r[t, k]]}]],
  {{k, 1, "function"}, rules, ControlType -> PopupMenu},
  {t, 0, 2 π}]

This shows the Manipulate with your parametric function selected

func-1

and this shows it with the other functions selected

func-2

update

I've redone this demonstration using correct functions for the center and radius of curvature. It looks much better.

Clear[t]; forms = {{3 Cos[t], 2 Sin[t]}, {Cos[t], Sin[2 t]}};
lbls = ToString /@ forms;
indxs = Range[Length[forms]];
rules = Thread[Rule[indxs, lbls]];
(r[t_, #] = forms[[#]]) & /@ indxs;
(dr[t_, #] = D[r[t, #], t]) & /@ indxs;
(d2r[t_, #] = D[r[t, #], {t, 2}]) & /@ indxs;
(uT[t_, #] = Simplify[dr[t, #]/Norm[dr[t, #]], t ∈ Reals]) & /@ indxs;
(vN[t_, #] = Simplify[With[{du = D[uT[t, #], t]}, du/Norm[du]], t ∈ Reals]) & /@ indxs;
(radius[t_, #] = 
  Simplify[
    Norm[dr[t, #]]^3 /
      Abs[dr[t, #][[1]] d2r[t, #][[2]] - dr[t, #][[2]] d2r[t, #][[1]]],
    t ∈ Reals]) & /@ indxs;
(center[t_, #] = Simplify[r[t, #] + radius[t, #] vN[t, #], t ∈ Reals]) & /@ indxs;

The Manipulate expression remains the same. With the new definitions for radius and center, the osculating circles are drawn correctly.

func-3

func-4

share|improve this answer
    
Bravo! Radius is now lowest at point of highest curvature which is much more intuitive. –  eldo May 25 at 19:17
    
Thanks! Do you know how I could add labels in the menu like Eclipse,Lemniscate? –  user14520 May 25 at 23:55
    
@user14520. Yes I could do that, but do you want to substitute the names for the curve forms, or do you want them as an addition to the curve forms? BTW, Eclipse and Lemniscate are not correct names for the curves I used in the above code. I really feel labeling with the forms gives the most informative labeling. –  m_goldberg May 26 at 0:15
    
@user14520 - please see my new answer below which add labels to the menu –  eldo May 26 at 13:00
    
m_goldberg the simulation runs very nisley on Mathematica but when I run it on cdf preview there is an error. like center[0,1] should be a pair of numbers or scaledOffset form. –  user14520 May 26 at 18:43

Manipulate can be tricky, and it's sometimes hard to answer questions without simply doing a full implementation for the OP. In this case, it is possible to adapt the OP's initial structure, but there are several issues that makes a simple fix elusive. They are primarily related to the scope of symbols.

(The side issue of an incorrect formula for curvature has been pointed out by m_goldberg. That will be left to the OP.)

The control

Before we get to the issues, let me first present the way I might create the control. I will deal with the issues later. First make the list of functions you want to use. This can be done is two steps: Make a list of expressions and convert them to functions. The list of expressions is easy to maintain.

Clear[t];
fns = {{3 Cos[t], Sin[t]}, {Cos[3 t], Sin[t]}, {t, Cos[t]}};
fns = Function @@@ Thread[{t, fns}];

The control can be inserted into the Manipulate with the code

{{r, First[fns]}, # -> #[t] & /@ fns, PopupMenu},

The issues

First, in a global definition like this

uT[t_] := Simplify[r'[t]/Norm[r'[t]], t \[Element] Reals]

the symbol r is a variable in the Global` context Global`r. But in Manipulate, by default, r will have a context that is local to the cell in which the Manipulate output appears.

Second, the definition

y2[t_] = r[t] + ((1/(uT[t]/r'[t])) vN[t])

which uses Set, will use the current definition of r. If r is not yet defined, then uT will be evaluated and the definition ends up with Norm'[r'[t]] in it, and Norm' is undefined.

Third, another issue has to do with the symbol t as a symbolic variable in a function expression and as a numeric value of the parameter to be substituted for the symbolic variable. Care has to be taken to keep the two uses from clashing.

There are various ways to deal with these issues. The simplest way to deal with the first is to use the option LocalizeVariables -> False. It may not be the best way, depending on what else is going on in the user's Mathematica session. The second is handles by using SetDelayed (:=). For the third, the best thing to do is to use two different symbols, say t for the symbolic variable and t0 for the numeric value.

One fix

Clear[t, r, y2];
uT[t_] := Simplify[r'[t]/Norm[r'[t]], t \[Element] Reals]
vN[t_] := Simplify[uT'[t]/Norm[uT'[t]], t \[Element] Reals]
x[t_] := r[t][[1]]
y[t_] := r[t][[2]]
y2[t_] := r[t] + ((1/(uT[t]/r'[t])) vN[t]);
OlcusionPoint[t_] := y2[t][[1]];
OclusionPoint2[t_] := y2[t][[2]];

fns = {{3 Cos[t], Sin[t]}, {Cos[3 t], Sin[t]}, {t, Cos[t]}};
fns = Function @@@ Thread[{t, fns}];
t0 = 0.0001; (* needed if localization is false *)

Manipulate[
 Show[Graphics[{RGBColor[0.6, 0.6, 0.8], 
    Disk[{OlcusionPoint[t0], OclusionPoint2[t0]}, 
     Abs[1/(uT[t0]/r'[t0])]]}], 
  ParametricPlot[{x[t], y[t]}, {t, 0, 2 Pi}], 
  Graphics[{PointSize[.025], Point[{x[t0], y[t0]}]}]],

 {{r, First[fns]}, # -> #[t] & /@ fns, PopupMenu},

 {{t0, 0.0001, t}, 0.0001, 2 Pi},

 LocalizeVariables -> False, SaveDefinitions -> True]

Another fix

I would localize things. The ControlType -> None make the symbol be localized in the DynamicModule created by Manipulate. The form {{x, x}, ...} initializes the symbol x to the symbol x; otherwise, it will be initialized to 0, the default initialization. This is needed for the SetDelayed definition of x in the Initialization option to work.

Update: Curvature is fixed; code is simplified.

Clear[t];

fns = {{3 Cos[t], Sin[t]}, {Cos[3 t], Sin[t]}, {t, Cos[t]}};
fns = Function @@@ Thread[{t, fns}];

Manipulate[
 With[{curve = ParametricPlot[r[t], {t, 0, 2 Pi}]},
  Show[
   Graphics[{RGBColor[0.6, 0.6, 0.8], Disk[y2[t0], rad[t0]]}],
   curve,                  (* draw curve on top of osculating disk *)
   Graphics[{PointSize[.025], Point[r[t0]]}],
   ImageSize -> 400, PlotRangePadding -> Scaled[0.15], Axes -> False,
   Options[curve]]         (* Primarily to get the PlotRange *)
  ],

 {{r, First[fns]}, # -> #[t] & /@ fns, PopupMenu},

 {{t0, 0.0001, t}, 0.0001, 2 Pi},

 {{uT, uT}, ControlType -> None}, {{vN, vN}, ControlType -> None},
 {{y2, y2}, ControlType -> None}, {{rad, rad}, ControlType -> None},

 Initialization :> (
   uT[t_] := #/Norm[#] &[r'[t]] // ComplexExpand;
   vN[t_] := #/Norm[#] &[uT'[t]];
   rad[t_] := Norm[r'[t]]/Norm[uT'[t]];
   y2[t_] := r[t] + rad[t] vN[t];
   )]

The list of dummy controls can be generated with

Thread[{Transpose[{#, #}] &@{
    uT, vN, y2, rad
    }, ControlType -> None}]

which is a form that is relatively easy to maintain. One could also put it directly into Manipulate with

Evaluate[
 Sequence @@ Thread[{Transpose[{#, #}] &@{
      uT, vN, y2, rad
      }, ControlType -> None}]
 ]

but you lose the syntax coloring.

share|improve this answer
    
I estimate your effort, but it's far too complicated - just plug your formulas into my code below. –  eldo May 25 at 18:29

I try to clarify things a little bit further:

ClearAll[a, b, t]

ClearAll@J
J[{x_, y_}] := {-y, x}

Two fundamental definitions:

ClearAll@Evolute
Evolute[a_][t_] := a[t] + a'[t].a'[t]/(a''[t].J[a'[t]]) J[a'[t]]

ClearAll@Curvature
Curvature[a_][t_] := a''[t].J[a'[t]]/Norm[J[a'[t]]]^3

give us:

ClearAll@OsculatingCircle
OsculatingCircle[a_][t_] := Circle[Evolute[a][t], 1/Curvature[a][t]]

Some curves:

ClearAll[circle, eight, ellipse, parabola]
circle[a_][t_] := {a Cos[t], a Sin[t]}
eight[a_][t_] := {Cos[t], Sin[a*t]}
ellipse[a_, b_][t_] := {a Cos[t], b Sin[t]}
parabola[a_][t_] := a {2 t, t^2}

You can now compute f.e.:

Curvature[eight[a]][t] // FullSimplify

giving

(a (Cos[t] Cos[a t] + a Sin[t] Sin[a t]))/(Abs[a Cos[a t]]^2 + Abs[Sin[t]]^2)^(3/2)

or

Curvature[circle[3]][#] & /@ Range[-Pi, Pi, Pi/4]

giving

{1/3, 1/3, 1/3, 1/3, 1/3, 1/3, 1/3, 1/3, 1/3}

(a circle has, of course, constant positive curvature)

Plotting example:

gr = Graphics[OsculatingCircle[ellipse[2, 1]][#] & /@ Range[-Pi, Pi, Pi/4];

pp = ParametricPlot[ellipse[2, 1][t], {t, -Pi, Pi}, 
     PlotStyle -> Directive[Thick, Red]];

Show[pp, gr, PlotRange -> All];

enter image description here

Animate with:

fun = "ellipse[2,1]";
Clear@p;
t = -Pi;

Manipulate[

 Show[
  Graphics[OsculatingCircle[ToExpression@fun][p] /. p -> t],
  ParametricPlot[(ToExpression@fun)[t], {t, -Pi, Pi}, 
   PlotStyle -> Directive[Thick, Red]], ImageSize -> {500, 500}],

 Column[{
   Dynamic@Slider[Dynamic@t, 
     Switch[fun, 
      "eight[2]", {-Pi/2 + 0.001, Pi/2 - 0.001}, _, {-Pi, Pi}]],

   PopupMenu[Dynamic@fun, {"ellipse[2,1]", "parabola[2]", "eight[2]"},
     FieldSize -> {10, 1}]
   }],

 TrackedSymbols -> {t, fun}]
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.