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 need to visualize Menelaus' theorem for a triangle with moving locators for each of six points. So the vertexes of the triangle can move in any possible way, and the three points on the sides of the triangle can not - they should be fixed on the side.

I've tried manipulating stuff, but I cant merge the Manipulate with

Locator[Dynamic[pa1, (pa1 = ToTheLine[#, pb, pc]) &]]

So I've come to this:

ToTheLine[p_, lb_, le_] :=
  {
    p[[1]], 
    If[le[[1]] == lb[[1]],
      p[[2]],
      lb[[2]] - (lb[[1]] - p[[1]])*(le[[2]] - lb[[2]])/(le[[1]] - lb[[1]])]
  }

DynamicModule[{
  pa = {-5, 0}, pb = {5, 0}, pc = {0, 10},
  pa1 = (pb + pc)/2, pb1 = (pa + pc)/2, pc1 = (pb + pa)/2},
  (* point pa1 is labeled as D and is on side BC of the triangle, 
     similar definition for the others *)
  Graphics[{
      Locator[Dynamic[pa]], (* point A *)
      Locator[Dynamic[pb]], (* point B *)
      Locator[Dynamic[pc]], (* point C *)
      Locator[Dynamic[pa1, (pa1 = ToTheLine [#, pb, pc]) &]],
      Locator[Dynamic[pb1, (pb1 = ToTheLine [#, pc, pa]) &]],
      Locator[Dynamic[pc1, (pc1 = ToTheLine [#, pb, pa]) &]],
      Text[Style["A", 20, "Label"], Dynamic[pa + {0, 1}]],
      Text[Style["B", 20, "Label"], Dynamic[pb + {0, 1}]],
      Text[Style["C", 20, "Label"], Dynamic[pc + {0, 1}]],
      Text[Style["D", 10, "Label"], Dynamic[pa1 + {0, 1}]],
      Text[Style["E", 10, "Label"], Dynamic[pb1 + {0, 1}]],
      Text[Style["F", 10, "Label"], Dynamic[pc1 + {0, 1}]],
      Thick, Red, 
      Line [{Dynamic[pa], Dynamic[pb], Dynamic[pc], Dynamic[pa]}],
      Thin, Black,
      Line [{Dynamic[pa], Dynamic[pc1]}],
      Line [{Dynamic[pb], Dynamic[pa1]}],
      Line [{Dynamic[pc], Dynamic[pb1]}],
      Line [{Dynamic[pa1], Dynamic[pb1]}],
      Line [{Dynamic[pb1], Dynamic[pc1]}]},
    PlotRange -> 20.
    Axes -> True.
    ImageSize -> 600]]

The function ToTheLine just gets locator coords and puts the points on a line defined by two other points.

When I drag a point on the side and then drag vertex, the point doesnt stay on side anymore. I tried Locator[Dynamic[pc1, (pc1 = ToTheLine [#, Dynamic[pb], Dynamic[pa]]) &]], which uses correct coords for A and B, but there is some error there.

How can I solve this problem? Is there a far more elegant solution?

share|improve this question
    
There's a demonstration for it. But I'd agree that it's not always easy to understand the code of a demonstration... –  cormullion Mar 26 '13 at 15:13
    
i've seen the demonstration. but in that demonstration there are no constrained locators. –  I.Alexandrov Mar 26 '13 at 15:24
    
No worries, just thought it was worth a look if you hadn't seen it. –  cormullion Mar 26 '13 at 15:34
    
Welcome to Mathematica.SE! I suggest the following: 1) As you receive help, try to give it too, by answering questions in your area of expertise. 2) Read the faq! 3) When you see good questions and answers, vote them up by clicking the gray triangles, because the credibility of the system is based on the reputation gained by users sharing their knowledge. Also, please remember to accept the answer, if any, that solves your problem, by clicking the checkmark sign! –  belisarius Mar 26 '13 at 19:56

2 Answers 2

First I address the general solution, and below treat the particular case of your example.

Make a list of locators in a particular order such as

locators = { tri1, tri2, tri3, opp1, opp2, opp3 }

where the tri are the coordinates of the triangle and the opp are the coordinates of the points on the side opposite the respective vertex. Note in Menelaus theorem, at least one point lies on the extension of a side.

Next, each time one of the locators is moved, the list of all six points needs to be updated. I'd suggest using a function like

newConfig[loc_List, {{}}] := loc;
newConfig[loc_List, {{moved_}}] := ...

The variable moved will be the index (returned by Position below) of the locator in the list of points loc that moved. The function newConfig would compute a new configuration depending on which one moved. In your case, it could constrain the opp locators to lie on a line.

The general structure of the Manipulate would be

Manipulate[
 LocatorPane[
  Dynamic[locators, (locators = newConfig[#, Position[locators - #, Except[{0., 0.}], {1}, 1, Heads -> False]]) &],
  Dynamic@Graphics[{(* graphics for figure *)}]
 ],
 {{locators, ..(* init.config.*)}, None}]

If you'd prefer DynamicModule you could use that instead of Manipulate, but it is possible to use Manipulate.


Example: Menelaus' Theorem

First, the configuration of the locators: the points are ordered so that if locator[[i]] is a vertex of the triangle, then locator[[i+3]] is on the opposite side.

Second, whenever a locator is moved, two points need updating. When the locator is a vertex of the triangle, the points are the nonvertices on the adjacent sides. When the locator is a point on a side, the points are one of the other side points and the locator itself; which side point is arbitrary but determines the behavior. Below, I made a cyclic choice so that the behavior has a somewhat symmetric feel. Which points need updating when a given point is moved is encoded in the list of rules $movedToUpdate.

  (* moving a point causes others to need updating according to the following rules *)
$movedToUpdate = {1 -> {5, 6}, 2 -> {4, 6}, 3 -> {4, 5},
   4 -> {5, 4}, 5 -> {6, 5}, 6 -> {4, 6}};

  (* finds the intersection of a line = {p1, p2} and its conjugate, line+3 *)
lineEq[twopoints_] := 
  Det[Transpose[twopoints~Join~{{x, y}}]~Join~{{1, 1, 1}}] == 0;
intersection[points_, line_] :=
  {x, y} /. First@Solve[{lineEq[points[[line]]], lineEq[points[[line + 3]]]}, {x, y}];

  (* initial configuration of locators; last point determined by intersection *)
$initConfig = {{0., 0.5}, {-0.5, -0.5}, {0.5, -0.5}, {0.75, -0.5}, {0.25, 0.}};
    $initConfig = $initConfig~Join~{intersection[$initConfig, {1, 2}]};

newConfig[locs_, {{}}] := locs; (* in case of dynamic update when no locators moved *)
newConfig[locs_, {{moved_}}] :=
 Fold[ReplacePart[#1, #2 -> intersection[#1, DeleteCases[Range[3], Mod[#2, 3, 1]]]] &,
      locs, moved /. $movedToUpdate];

Manipulate[
 LocatorPane[
  Dynamic[locators,
    (locators = newConfig[#, Position[locators - #, Except[{0., 0.}], {1}, 1, Heads -> False]]) &],
  Dynamic@Graphics[
    GraphicsComplex[locators,
     {Line[{{4, 2, 3}, {1, 5, 3}, {1, 2, 6}, {4, 5, 6}}],
      Red, Line[{1, 2, 3, 1}], PointSize[Large], Red, Point[Range[6]]}],
    PlotRange -> 1]
  ],
 {{locators, $initConfig}, None}]

Mathematica graphics

share|improve this answer
d = Dynamic;
s[{x_, i_, y_}] := Text[Style[x, 10 i, "Label"], Dynamic[y + {0, 1}]]
toLine[pt_, start_, end_] := Module[{param = ((pt-start).(end-start))/Norm[end-start]^2}, 
                                    start + Clip[param, {0, 1}] (end - start)]
DynamicModule[{
  pa  = {-5, 0},     pb = {5, 0},       pc  = {0, 10},
  pa1 = (pb + pc)/2, pb1 = (pa + pc)/2, pc1 = (pb + pa)/2},
 {Dynamic[pa1 = toLine[pa1, pb, pc]; pb1 = toLine[pb1, pa, pc]; pc1 = toLine[pc1, pb, pa];],
  Graphics[{
    s/@{{"A",2,d@pa},{"B",2,d@pb}, {"C",2,d@pc},{"D",1,d@pa1}, {"E",1,d@pb1}, {"F",1,d@pc1}},
    Thick, Red,  Line @ {d@pa, d@pb, d@pc, d@pa},
    Thin, Black, Line @ {d@pa, d@pc1, d@pb1, d@pc, d@pb1, d@pa1, d@pb},
    Locator /@          {d@pa, d@pc1, d@pb1, d@pc, d@pb1, d@pa1, d@pb},
    PlotRange -> 20, Axes -> True, ImageSize -> 600}]}]

Mathematica graphics

share|improve this answer
    
Thx a lot, its great! But i cant still figure how does dynamic works properly ( What if we want to dynamically count the distance between, say, D and line EF? Where should i put the calculation? xd = pa1[[1]]; yd = pa1[[2]]; x1 = pb1[[1]]; y1 = pb1[[2]]; x2 = pc1[[1]]; y2 = pc1[[2]]; n = Normalize[{y1 - y2, x2 - x1, x1*y2 - x2*y1}]; dist = Norm[n*{xd, yd, 1}]; –  I.Alexandrov Mar 26 '13 at 19:49
    
@I.Alexandrov In the DynMod vars add pe and replace the Dynamic for Dynamic[ pa1 = ToTheLine[pa1, pb, pc]; pb1 = ToTheLine[pb1, pa, pc]; pc1 = ToTheLine[pc1, pb, pa]; pe = Norm[pa1 - ToTheLine[pa1, pb1, pc1]]] –  belisarius Mar 26 '13 at 20:02
    
Just a side note: don't forget Deploy@Graphics[...]. –  Federico Mar 26 '13 at 23:40
1  
I'm surprised that both answers hadn't received any votes in almost a day... –  rm -rf Mar 27 '13 at 16:45

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.