11
$\begingroup$

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]

Imagem

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]

Imagem

I would like it in a format similar to this:

f[p1_, p2_, lVertical or lHorizontal]
| improve this question | |
$\endgroup$
  • $\begingroup$ @corey979 I did not know this function. I'll try to use it. $\endgroup$ – user45551 Dec 29 '16 at 12:03
  • $\begingroup$ I initially suggested AnglePath, but after playing with it in combination with Projection, UnitVectors etc., it turned out to be to cumbersome. $\endgroup$ – corey979 Dec 30 '16 at 15:34
12
$\begingroup$

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

enter image description here

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

enter image description here

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

enter image description here

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

enter image description here

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

path[pts, dir]

enter image description here

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

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

enter image description here

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

enter image description here

| improve this answer | |
$\endgroup$
8
$\begingroup$

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

enter image description here

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

enter image description here

| improve this answer | |
$\endgroup$
  • $\begingroup$ 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? $\endgroup$ – Mr.Wizard♦ Dec 31 '16 at 19:20
  • $\begingroup$ @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 $\endgroup$ – glS Dec 31 '16 at 19:24
  • $\begingroup$ When I have time I'll give it my best shot! ;^) $\endgroup$ – Mr.Wizard♦ Dec 31 '16 at 19:27
  • $\begingroup$ @Mr.Wizard awesome. Very interesting stuff. Thanks! $\endgroup$ – glS Jan 1 '17 at 16:07
  • 1
    $\begingroup$ 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. $\endgroup$ – glS Jan 2 '17 at 11:39
6
$\begingroup$

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]]}}
| improve this answer | |
$\endgroup$
5
$\begingroup$ 
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])

Mathematica graphics

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]

Mathematica graphics

| improve this answer | |
$\endgroup$
4
$\begingroup$

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]

enter image description here

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]

enter image description here

| improve this answer | |
$\endgroup$
2
$\begingroup$

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

| improve this answer | |
$\endgroup$

Your Answer

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