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

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]

• @corey979 I did not know this function. I'll try to use it.
– user45551
Dec 29, 2016 at 12:03
• I initially suggested AnglePath, but after playing with it in combination with Projection, UnitVectors etc., it turned out to be to cumbersome. Dec 30, 2016 at 15:34

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


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] :=
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[{
[email protected], Point@pts,
Dashed, Line@hvPath@pts
}]
]


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

• I believe your code would benefit from refactoring. If I do that may I edit your post to use my code (which you can revert if you do not like) or would you prefer that I post a separate answer? Dec 31, 2016 at 19:20
• @Mr.Wizard sure, suit yourself! I figured there should have been a much better way to write more concisely the conditions, and everything else. Show me your best one-liner! :P
– glS
Dec 31, 2016 at 19:24
• When I have time I'll give it my best shot! ;^) Dec 31, 2016 at 19:27
• @Mr.Wizard awesome. Very interesting stuff. Thanks!
– glS
Jan 1, 2017 at 16:07
• if you mean the use of a or b as a if not a then b, I can't say I had seen it before in Mathematica (except in the answer you linked), but it is a pretty commonly used technique in many other languages (bash being the first that comes to mind). I agree that Its use here makes for a rather elegant solution to the problem though.
– glS
Jan 2, 2017 at 11:39

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

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], #] &, #]},


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]


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