1
$\begingroup$

Here I am stating an initial point as a reference:

pInitial={0,0};

These are the points that belong to the group P:

groupP={{255,510},{160,250},{560,246}};

These are the points that belong to the group ABC:

groupABC={{473,437},{430,388},{175,138}};

How to create the following sequence?

1 - Create an arrow that starts at point pInitial.

2 - From this point to look for which point of the P group is closest.

3 - Then from this point P do search which point of the ABC group is closest.

4 - So from this point of the ABC group to find which point of the P group are closer and thus until the final.

The code below shows the idea. I created knowing what is the sequence to be followed. I did this manually.

gpInitial=Graphics[{Black,PointSize[0.04],Point[{0,0}]}];
gABC=Graphics[{Green,PointSize[0.03],Point[groupABC]}];
gP=Graphics[{Blue,PointSize[0.03],Point[groupP]}];
gArrow=Graphics[{Red,Arrowheads[0.05],Thickness[0.008],Arrow[{{0,0},{160,250},{175,138},{255,510},{430,388},{560,246},{473,437}}]}];
Show[{gpInitial,gP,gABC,gArrow},Axes->True]

enter image description here

$\endgroup$
4
$\begingroup$
Clear["Global`*"]

I believe that I have understood your idea. Would review the groups always looking for the nearest to the next group.

pInitial={0,0};
groupP={{255,510},{160,250},{560,246}};
groupABC={{473,437},{430,388},{175,138}};

Here I am preserving the initial values of the graphics:

gpInitial=Graphics[{Black,PointSize[0.04],Point[{0,0}]}];
gABC=Graphics[{Green,PointSize[0.03],Point[groupABC]}];
gP=Graphics[{Blue,PointSize[0.03],Point[groupP]}];

Here were separated values x and y from group P

px=groupP[[#,1]]&/@Range[3];
py=groupP[[#,2]]&/@Range[3];

Were created twos lists with distances in x and y from group P with respect to the pInitial

Δx=px[[#]]&/@Range[3]-pInitial[[1]];
Δy=py[[#]]&/@Range[3]-pInitial[[2]];

Here only one example how to obtain the closest distance

distMin=Min[Sqrt[Δx[[#]]^2+Δy[[#]]^2]&/@Range[3]]//N

Another option would be to use EuclideanDistance

Min[EuclideanDistance[pInitial,groupP[[#]]]&/@Range[3]]//N

The function below calculates what position in the Group P is the closest point and what the value of this distance

f[i_]:={pos=Position[EuclideanDistance[pInitial,groupP[[#]]]&/@i,Min[EuclideanDistance[pInitial,groupP[[#]]]&/@i]],Extract[(EuclideanDistance[pInitial,groupP[[#]]]&/@i),First@pos]};
sol=Flatten@f[Range[3]]//N

With the position in the 'Group P' found it applies the value for 'p1':

p1=groupP[[First[sol]]]

Now we will remove the point from the list used

groupP=Drop[groupP,{First[sol]}]

Now p1 is the new reference point. Until this moment I wanted to show the steps in greater detail. Now another possibility is to get positions through functions entering the new starting point and the group of points to be analyzed.

Where, pI is the new point andpG is the group of points.

f[pG_,pI_]:={pos=Position[EuclideanDistance[pI,Evaluate@pG[[#]]]&/@Range[Length[pG]],Min[EuclideanDistance[pI,Evaluate@pG[[#]]]&/@Range[Length[pG]]]],Extract[(EuclideanDistance[pI,Evaluate@pG[[#]]]&/@Range[Length[pG]]),First@pos]};
sol=Flatten[f[groupABC,p1]];
p2=groupABC[[First[sol]]];
groupABC=Drop[groupABC,{First[sol]}];
f[pG_,pI_]:={pos=Position[EuclideanDistance[pI,Evaluate@pG[[#]]]&/@Range[Length[pG]],Min[EuclideanDistance[pI,Evaluate@pG[[#]]]&/@Range[Length[pG]]]],Extract[(EuclideanDistance[pI,Evaluate@pG[[#]]]&/@Range[Length[pG]]),First@pos]};
sol=Flatten[f[groupP,p2]];
p3=groupP[[First[sol]]];
groupP=Drop[groupP,{First[sol]}];
f[pG_,pI_]:={pos=Position[EuclideanDistance[pI,Evaluate@pG[[#]]]&/@Range[Length[pG]],Min[EuclideanDistance[pI,Evaluate@pG[[#]]]&/@Range[Length[pG]]]],Extract[(EuclideanDistance[pI,Evaluate@pG[[#]]]&/@Range[Length[pG]]),First@pos]};
sol=Flatten[f[groupABC,p3]];
p4=groupABC[[First[sol]]];
groupABC=Drop[groupABC,{First[sol]}];
f[pG_,pI_]:={pos=Position[EuclideanDistance[pI,Evaluate@pG[[#]]]&/@Range[Length[pG]],Min[EuclideanDistance[pI,Evaluate@pG[[#]]]&/@Range[Length[pG]]]],Extract[(EuclideanDistance[pI,Evaluate@pG[[#]]]&/@Range[Length[pG]]),First@pos]};
sol=Flatten[f[groupP,p4]];
p5=groupP[[First[sol]]];
groupP=Drop[groupP,{First[sol]}];
f[pG_,pI_]:={pos=Position[EuclideanDistance[pI,Evaluate@pG[[#]]]&/@Range[Length[pG]],Min[EuclideanDistance[pI,Evaluate@pG[[#]]]&/@Range[Length[pG]]]],Extract[(EuclideanDistance[pI,Evaluate@pG[[#]]]&/@Range[Length[pG]]),First@pos]};
sol=Flatten[f[groupABC,p5]];
p6=groupABC[[First[sol]]];
groupABC=Drop[groupABC,{First[sol]}];
seq={pInitial,p1,p2,p3,p4,p5,p6}

gArrow=Graphics[{Red,Arrowheads[0.05],Thickness[0.008],Arrow[{seq}]}];
Show[{gpInitial,gP,gABC,gArrow},Axes->True]

enter image description here

$\endgroup$
  • $\begingroup$ I will try this code. $\endgroup$ – JPeter Sep 29 '16 at 20:16
  • $\begingroup$ I liked the explanation. Well detailed, but a bit confusing for me. $\endgroup$ – JPeter Sep 29 '16 at 20:18
4
$\begingroup$

This uses Nearest inside a While loop,

pInitial = {0, 0}; 
groupP = {{255, 510}, {160, 250}, {560, 246}};
groupABC = {{473, 437}, {430, 388}, {175, 138}};
path = Module[{pInitial = pInitial,
    groupP = groupP,
    groupABC = groupABC
    },
   Join[
    {pInitial},
    Reap[
      While[Length[Join[groupP, groupABC]] > 0,
        pInitial = First@Nearest[groupP, pInitial];
        Sow[pInitial];
        groupP = Complement[groupP, {pInitial}];
        pInitial = First@Nearest[groupABC, pInitial];
        Sow[pInitial];
        groupABC = Complement[groupABC, {pInitial}];
        ];
      ][[2, 1]]
    ]
   ];
Graphics[{PointSize@Large, Black, Point@pInitial, Blue, Point@groupP, 
  Green, Point@groupABC, Red, Line@path}, Axes -> True]

Mathematica graphics

$\endgroup$
  • $\begingroup$ I really wanted to write a two-line FoldList implementation, but I failed to do so..... $\endgroup$ – Jason B. Sep 29 '16 at 21:29

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.