# 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 '16 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. – corey979 Dec 30 '16 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[{
PointSize@0.02, 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? – Mr.Wizard Dec 31 '16 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 '16 at 19:24
• When I have time I'll give it my best shot! ;^) – Mr.Wizard Dec 31 '16 at 19:27
• @Mr.Wizard awesome. Very interesting stuff. Thanks! – glS Jan 1 '17 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 '17 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]]}}]