开发者

Visualizing a geometric puzzle with mathematica

开发者 https://www.devze.com 2023-01-20 06:48 出处:网络
I am trying to figure out a way to move two points, X and Y, independently of one another along the edges of an equilateral triangle with vertices A, B, and C.There are also some collision rules that

I am trying to figure out a way to move two points, X and Y, independently of one another along the edges of an equilateral triangle with vertices A, B, and C. There are also some collision rules that need to be taken into account:

(1) If X is at a vertex, say vertex A, then Y cannot be on A or on the edges adjacent to it. i.e., Y can only be on vertices B or C or the edge BC.

(2) If X is on an edge, say AB, then Y cannot be on A, nor B, nor any of the edges adjacent to A and B. i.e., Y must be on vertex C

I have figured out how to move the two points along the triangle using a pair of sliders, but I can't figure out how to implement the collision rules. I tried using the Exclusions option for Slider but the results are not what I expect. I would prefer to drag the points along the triangle rather than using sliders, so if someone knows how to do that instead it would be helpful. Ideally, I would be able to move the two points from a vertex to either one of the edges instead of coming to a stop at one of them. Here is my code so far.

MyTriangle[t_] :=

Piecewise[{{{-1, 0} + (t/100) {1, Sqrt[3]},

100 > t >= 0}, {{0, Sqrt[3]} + (t/100 - 1) {1, -Sqrt[3]},

200 > t >= 100},

{{1, 0} + (t/100 - 2) {-2, 0}, 300 >= t >= 0}}]

excluded[x_] := \[Piecewise] {

{Range[0, 99]~Join~Range[201, 299], x == 0},

{Range[0, 199], x == 100},

{Range[101, 299], x == 200},

{Range[0, 199]~Join~Range[201, 299], 0 < x < 100},

{Range[1, 299], 100 < x < 200},

{Range[0, 99]~Join~Range[101, 299], 200 < x < 300}

}

{Dynamic[t], Dynamic[x]}

{Slider[Dynamic[t], {0, 299, 1}, Exclusions -> Dynamic[excluded[x]]], Dynamic[t]}

{Slider[Dynamic[x], {0, 2开发者_JAVA百科99, 1}, Exclusions -> Dynamic[excluded[t]]], Dynamic[x]}

Dynamic[Graphics[{PointSize[Large], Point[MyTriangle[t]], Point[MyTriangle[x]],

Line[{{-1, 0}, {1, 0}, {0, Sqrt[3]}, {-1, 0}}]},

PlotRange -> {{-1.2, 4.2}, {-.2, 2}}]]

Visualizing a geometric puzzle with mathematica


How about something like:

MyTriangle[t_]:=Piecewise[{
    {{-1,0}+t {1,Sqrt[3]},1>t>=0},
    {{0,Sqrt[3]}+(t-1) {1,-Sqrt[3]},2>t>=1},
    {{1,0}+(t-2) {-2,0},3>=t>=0},{0,True}}]

and

Column[{
  {Slider[Dynamic[x], {0, 3, .01}], Dynamic[x]},
  {Slider[Dynamic[y], {0, 3, .01}], Dynamic[y]},
  Dynamic[x = Mod[x, 3]; Which[
   x==0.,Which[0.<=y<1.,y=1.,2.<y<=3.,y=2.],0.<x<1.,y=2.,
   x==1.,Which[1.<=y<2.,y=2.,0.<y<=1.,y=0.],1.<x<2.,y=0.,
   x==2.,Which[2.<=y<3.,y=0.,1.<y<=2.,y=1.],2.<x<3.,y=1.];
   Graphics[{PointSize[Large], Point[MyTriangle /@ {x, y}], 
     Line[{{-1, 0}, {1, 0}, {0, Sqrt[3]}, {-1, 0}}]}]]}]
0

精彩评论

暂无评论...
验证码 换一张
取 消

关注公众号