Function to create a path made of horizontal and vertical lines between a number of points

Question

I would like to create a function where I can define which case I want to use to create a path.

p1 = {40, 48}; p2 = {50, 116}; p3 = {63, 160};
listPurple = Symbol["p" <> ToString[#]] & /@ Range[3];
disksPurple = {Purple, Disk[#, 2] & /@ listPurple};
Graphics[{disksPurple}, ImageSize -> 200]

I do not want two functions, as I created:

lVertical[p1_, p2_] := {p1, {p1[[1]], p2[[2]]}};
lHorizontal[p1_, p2_] := {p1, {p2[[1]], p1[[2]]}};

With them I define whether it will be a horizontal or vertical line:

l1 = lVertical[p1, p2];
l2 = lHorizontal[p2, p1];
l3 = lHorizontal[p2, p3];
l4 = lVertical[p3, p2];
lines = Sort@Symbol["l" <> ToString[#]] & /@ Range[4];
l = {Red, Dashed, Line[#] & /@ lines};
Graphics[{l, disksPurple}, ImageSize -> 200]

I would like it in a format similar to this:

f[p1_, p2_, lVertical or lHorizontal]

Answer 1

Function:

path[points_List, directions_List] := 
 Block[{disksPurple, pseudoCross, v, h, ints, dirs},
  If[Length@directions != Length@points - 1, Print["incorrect input"]; Abort[]];
  disksPurple = {Purple, Disk[#, 2] & /@ points};
  pseudoCross[p1_, p2_] := {{p1[[1]], p2[[2]]}, {p2[[1]], p1[[2]]}};
  dirs = directions /. {v -> {1, 0}, h -> {0, 1}};
  ints = Flatten[#, 1] & @ Pick[pseudoCross @@@ Partition[points, 2, 1], dirs, 1];
  Graphics[{disksPurple, {Red, Dashed, Line @ Riffle[points, ints]}}]
  ]

Usage: list of points is the first argument; the second is a list of directions (only first directions) between the consecutive points. E.g., to go from p1 to p2 first vertically, and then horizontally, type v; to go first horizontally, then vertically - type h. The reason is that if you go vertically from p1, you have to go horizontally next to reach p2, and vice versa.

Examples:

Clear[p1, p2, p3, p4, pts]
p1 = {40, 48}; p2 = {50, 116}; p3 = {63, 160}; p4 = {80, 100};
pts = {p1, p2, p3, p4};

path[pts, {v, v, v}]

path[pts, {h, h, h}]

path[pts, {v, h, h}]

path[pts, {v, h, v}] (* this is correct, just the choice of direction is poor *)

---

n = 10;
pts = RandomInteger[{0, 100}, {n, 2}];
dir = RandomChoice[{v, h}, Length@pts - 1];

path[pts, dir]

Works also when three consecutive points have their $x$ or $y$ coordinates the same:

path[{{100, 0}, {200, 0}, {300, 0}}, {h, h}]

The same image is obtained with {v, v}, {v, h} and {h, v}; similarly for the vertical alignment.

---

Incorrect input:

path[{{100, 0}, {200, 0}, {300, 0}}, {h, h, v}]

incorrect input

$Aborted

---

And finally, there's this funny behaviour when you make a typo in the directions:

Clear[p1, p2, p3, p4, pts, path]
p1 = {40, 48}; p2 = {50, 116}; p3 = {63, 160}; p4 = {80, 100};
pts = {p1, p2, p3, p4};
path[pts, {v, v, hv}]

Answer 2

Here is an attempt at automatically finding the best paths to use to join the points. This avoids having to explicitly give the horizontal and vertical specification for every point.

ClearAll[generateDirections, hvPath]

generateDirections[pts_, initialDirection_] :=
 Module[{d = initialDirection /. None :> RandomChoice[{1, 2}]},
  Join[{d},
   (Ordering[#[[All, d = 3 - d]]][[2]] == 2 || (d = 3 - d); d) & /@ 
    Partition[pts, 3, 1]]
 ]

hvPath[{pt1 : {a_, b_}, pt2 : {i_, j_}}, dir_] :=
  {pt1, Switch[dir, 1, {i, b}, 2, {a, j}], pt2}

hvPath[pts : {{_, _} ..}, initialDirection_ : None] :=
 Join @@ MapThread[
   hvPath, {Partition[pts, 2, 1], generateDirections[pts, initialDirection]}]

The idea is to use generateDirections to generate the best horizontal-vertical pathways, using the rule of thumb of initiating every new path using alternativily horizontal and vertical lines, except when this results in going over the same line used to arrive to the given point. Once the optimal directions are found the rest is easily handled by hvPath which generates the list with all the middle points.

Here is a couple of usage example:

With[{pts = {{0, 0}, {1, 1}, {2, 2}, {3, 3}}},
 Graphics[{
   PointSize@0.02, Point@pts,
   Dashed, Line@hvPath@pts
   }]
 ]

and a more complex one in which we join 20 random points:

Answer 3

You can simply provide two definitions for f

f[p1_, p2_, lVertical] := {p1, {p1[[1]], p2[[2]]}}
f[p1_, p2_, lHorizontal] := {p1, {p2[[1]], p1[[2]]}}

Answer 4

ClearAll[f, pathF]
f[dir : v | h][p1_, p2_] := Module[{d = dir /. {v -> 2, h -> 1},
     mid = {{p1[[1]], p2[[2]]}, {p2[[1]], p1[[2]]}}}, {p1, mid[[3 - d]], p2}];

pathF[p_List, dir_List] := Join@@(f[#2][## & @@ #]&@@@ Transpose[{Partition[p, 2, 1], dir}])

pts = {{40, 48}, {50, 116}, {63, 160}, {80, 100}};
Grid[Partition[#, 4]] &@(ListPlot[pathF[##], Joined -> True, 
       Epilog -> {PointSize[Large], Red, Point[#]}, 
       PlotLabel -> #2] &[pts, #] & /@ Tuples[{v, h}, 3])

points = RandomReal[{-50, 50}, {8, 2}];
dirs = RandomChoice[{v, h}, 7];
ListPlot[pathF[##], Joined -> True, PlotLabel -> #2, Axes -> False,  
   Epilog -> {PointSize[.05], Opacity[.5, Red], Point@#, 
     Opacity[1, Black], MapIndexed[Text[Style[#2[[1]], 16], #] &, #]}, 
   PlotRangePadding -> 5] &[points, dirs]

Answer 5

Quick Draw (for an alternative way to do the job using some unknown MMA functionality)

n=10;
pts= RandomReal[1, {n, 2}];

ListLinePlot[pts, InterpolationOrder -> 0, 
Mesh -> Full, MeshStyle -> Purple, PlotStyle -> {Red, Dashed}, Frame -> True]

Different formation can be created by considering different arrangement

pts1 = pts[[RandomSample[Range[n], n]]];
ListLinePlot[pts1, InterpolationOrder -> 0, Mesh -> Full, 
MeshStyle -> Purple, PlotStyle -> {Red, Dashed}, Frame -> True]

Answer 6

Try this:

p1 = {40, 48}; p2 = {50, 116}; p3 = {63, 160};
listPurple = Symbol["p" <> ToString[#]] & /@ Range[3];
disksPurple = {Purple, Disk[#, 2] & /@ listPurple};
Graphics[{disksPurple}, ImageSize -> 200];

fLine[p1_, p2_, case_] := 
 If[TrueQ[case == v], {p1, {p1[[1]], p2[[2]]}}, {p1, {p2[[1]], 
    p1[[2]]}}]

l1 = fLine[p1, p2, v];
l2 = fLine[p2, p1, h];
l3 = fLine[p2, p3, h];
l4 = fLine[p3, p2, v];
lines = Sort@Symbol["l" <> ToString[#]] & /@ Range[4];
l = {Red, Dashed, Line[#] & /@ lines};
Graphics[{l, disksPurple}, ImageSize -> 200]

This part you choose cases:

fLine[p1_, p2_, case_] := If[TrueQ[case == v], {p1, {p1[[1]], p2[[2]]}}, {p1, {p2[[1]], p1[[2]]}}]