Визуализация геометрической головоломки с Mathematica - PullRequest
Новая
       28

Визуализация геометрической головоломки с Mathematica

1 голос
/ 19 октября 2010

Я пытаюсь найти способ перемещения двух точек, X и Y, независимо друг от друга по краям равностороннего треугольника с вершинами A, B и C. Есть также некоторые правила столкновения, которые необходимопринимается во внимание:

(1) Если X находится в вершине, скажем, в вершине A, то Y не может быть на A или на соседних с ним ребрах.т. е. Y может быть только на вершинах B или C или ребре BC.

(2) Если X на ребре, скажем AB, то Y не может быть ни на A, ни на B, ни на каком-либо ребрерядом с A и B. т. е. Y должен находиться в вершине C

. Я понял, как с помощью пары ползунков перемещать две точки вдоль треугольника, но я не могу понять, как реализоватьправила столкновения.Я попытался использовать опцию Исключения для Слайдера, но результаты не соответствуют ожиданиям.Я бы предпочел перетаскивать точки вдоль треугольника, а не с помощью ползунков, поэтому, если кто-то знает, как это сделать, это будет полезно.В идеале я мог бы переместить две точки от вершины к одному из ребер вместо того, чтобы остановиться на одной из них.Вот мой код.

MyTriangle[t_] :=<br> Piecewise[{{{-1, 0} + (t/100) {1, Sqrt[3]},<br> 100 > t >= 0}, {{0, Sqrt[3]} + (t/100 - 1) {1, -Sqrt[3]},<br> 200 > t >= 100},<br> {{1, 0} + (t/100 - 2) {-2, 0}, 300 >= t >= 0}}]<br> excluded[x_] := \[Piecewise] {<br> {Range[0, 99]~Join~Range[201, 299], x == 0},<br> {Range[0, 199], x == 100},<br> {Range[101, 299], x == 200},<br> {Range[0, 199]~Join~Range[201, 299], 0 < x < 100},<br> {Range[1, 299], 100 < x < 200},<br> {Range[0, 99]~Join~Range[101, 299], 200 < x < 300}<br> }<br> {Dynamic[t], Dynamic[x]}<br> {Slider[Dynamic[t], {0, 299, 1}, Exclusions -> Dynamic[excluded[x]]], Dynamic[t]}<br> {Slider[Dynamic[x], {0, 299, 1}, Exclusions -> Dynamic[excluded[t]]], Dynamic[x]}<br> Dynamic[Graphics[{PointSize[Large], Point[MyTriangle[t]], Point[MyTriangle[x]],<br> Line[{{-1, 0}, {1, 0}, {0, Sqrt[3]}, {-1, 0}}]},<br> PlotRange -> {{-1.2, 4.2}, {-.2, 2}}]]

Mathematica graphics

1 Ответ

2 голосов
/ 19 октября 2010

Как насчет чего-то вроде: 

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}}]

и 

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}}]}]]}]
...