Selecting the closest points alternating group lists

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]}];
Show[{gpInitial,gP,gABC,gArrow},Axes->True]


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}

Show[{gpInitial,gP,gABC,gArrow},Axes->True]


• I will try this code. Sep 29, 2016 at 20:16
• I liked the explanation. Well detailed, but a bit confusing for me. Sep 29, 2016 at 20:18

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]


• I really wanted to write a two-line FoldList` implementation, but I failed to do so..... Sep 29, 2016 at 21:29