12

How can I prevent plotting functions from "connecting" inside a plot points that should "wrap around" outside the plot?

For example, how do I eliminate the horizontal lines running across the following ParametricPlot?

enter image description here

In this figure, the paths that reach the right hand end of the graph at 24 should continue at 0 (these are hours, so 24=0) without passing backwards across the figure.

Show[
 ParametricPlot[
  {AstronomicalData[
    "Mars", {"RightAscension", 
     DatePlus[Date[], d], {$GeoLocation[[1]] , $GeoLocation[[2]]}}], d},
  {d, 0, 365}, AspectRatio -> 1/1.6, PlotStyle -> Blue],
 ParametricPlot[
  {AstronomicalData[
    "Mercury", {"RightAscension", 
     DatePlus[Date[], d], {$GeoLocation[[1]] , $GeoLocation[[2]]}}], d},
  {d, 0, 365}, AspectRatio -> 1/1.6, PlotStyle -> Red],
 ParametricPlot[
  {AstronomicalData[
    "Jupiter", {"RightAscension", 
     DatePlus[Date[], d], {$GeoLocation[[1]] , $GeoLocation[[2]]}}], d},
  {d, 0, 365}, AspectRatio -> 1/1.6, PlotStyle -> Green]
 ]

FWIW, the (almost) final result, with help from SE: enter image description here

orome
  • 12,819
  • 3
  • 52
  • 100

7 Answers7

6

Theoretically the Exclusions option should be able to handle this but I couldn't find the right arguments. Therefore I recommend a method similar to Simon's, but I would instead Split the lines where there are any large discontinuities in x :

(* Simon's code *)
plot = Show[MapThread[ParametricPlot[
 {AstronomicalData[#1, {"RightAscension", DatePlus[Date[], d], $GeoLocation}], d},
 {d, 0, 365}, AspectRatio -> 1/1.6, PlotStyle -> #2] &, 
 {{"Mars", "Mercury", "Jupiter"}, {Blue, Red, Green}}]];


plot /. Line[x_] :> Line@Split[x, Norm[# - #2] < 10 &]

Mathematica graphics

Mr.Wizard
  • 271,378
  • 34
  • 587
  • 1,371
  • That certainly looks tidier than my CW answer. But I'm a bit foggy on what's going on with Line and :>. Is there a reason to prefer that approach over simply including the Split in the plot, as in the CW answer? – orome Oct 08 '12 at 23:52
  • Ah, I think I see the answer. My approach only works because I've "switched" to ListPlot, while this one works for any plot since it's operating on the Line primitive. (And yes, I tired Exclusions but could not get it to work.) – orome Oct 08 '12 at 23:55
  • @rax I missed the CW answer. (I had this half written, walked away, and then finished it and posted.) The ListPlot method is entirely reasonable, but I assumed that you specifically wanted to use ParametricPlot. This method should work with any functions that have sudden "jumps" in them. – Mr.Wizard Oct 08 '12 at 23:56
  • As long as there's no performance hit, this is better. Could you add a bit of explanation about what the substitution is doing for those of us who are not as sophisticated as we pretended to be. I'm always a bit puzzled about :>, and am not clear about how Line and Norm are working here. – orome Oct 09 '12 at 00:00
  • 1
    @rax If you are not familiar with transformation rules you will need to start here. Specifically here the output of ParametricPlot is a Graphics object constructed of primitives such as Line and Options such as PlotRange. My transformation rule (applied with /.) is RuleDelayed (:>) so that the right-hand-side does not evaluate until x is substituted in. Norm is just a short-hand to check the distance between points; EuclideanDistance would work too, perhaps better. – Mr.Wizard Oct 09 '12 at 00:12
  • 1
    I used to use this precise strategy of Split[]-ting Line[] objects produced by plotting functions, for removing "long" or "steep" lines in plots, before the Exclusions option came along. I don't know about the advantages of rewriting the splitting test in terms of EuclideanDistance[], but Norm[# - #2] < 10 & is the same as EuclideanDistance[#, #2] < 10 &. – J. M.'s missing motivation Oct 09 '12 at 07:42
  • 1
    Ah, Split, much neater! I completely forgot about the existence of Split, even whilst thinking "I need to SPLIT this line into two"... – Simon Woods Oct 09 '12 at 09:14
  • @J.M. since you are a user from early versions I'm sure you have many such methods that have been replaced with built-in functionality over time. I'd be interested in seeing more of them myself, and perhaps others would too. I often use Norm but EuclideanDistance appears to be faster. I guess that's a habit I picked up before the latter was introduced and I haven't kicked it because Norm is shorter. – Mr.Wizard Oct 09 '12 at 15:21
  • I've updated the CW answer to deal with a problem that arises when applying this solution to ListPlot. Feel free to incorporate here. – orome Oct 14 '12 at 19:46
4

A simple hack for this specific problem is to split each Line primitive into two at the first occurrence of a small x value:

plot = Show[MapThread[ParametricPlot[
 {AstronomicalData[#1, {"RightAscension", DatePlus[Date[], d], $GeoLocation}], d},
 {d, 0, 365}, AspectRatio -> 1/1.6, PlotStyle -> #2] &, 
 {{"Mars", "Mercury", "Jupiter"}, {Blue, Red, Green}}]];

plot /. Line[{pts1__, {x_ /; x < 1, _}, pts2__}] :> {Line[{pts1}], Line[{pts2}]}

enter image description here

Simon Woods
  • 84,945
  • 8
  • 175
  • 324
3

This might be more simplistic than you were looking for but you could always just break it up into several sections and show them together

p1 = ParametricPlot[{AstronomicalData[
"Mars", {"RightAscension", 
 DatePlus[Date[], d], {$GeoLocation[[1]], $GeoLocation[[2]]}}], 
d}, {d, 155, 365}, AspectRatio -> 1/1.6, PlotStyle -> Blue, 
PlotRange -> All, AxesOrigin -> {0, 0}];

p2 = ParametricPlot[{AstronomicalData[
"Mars", {"RightAscension", 
 DatePlus[Date[], d], {$GeoLocation[[1]], $GeoLocation[[2]]}}], 
d}, {d, 0, 154}, AspectRatio -> 1/1.6, PlotStyle -> Blue, 
PlotRange -> All];

p3 = ParametricPlot[{AstronomicalData[
"Mercury", {"RightAscension", 
 DatePlus[Date[], d], {$GeoLocation[[1]], $GeoLocation[[2]]}}], 
d}, {d, 0, 186}, AspectRatio -> 1/1.6, PlotStyle -> Red];

p4 = ParametricPlot[{AstronomicalData[
"Mercury", {"RightAscension", 
 DatePlus[Date[], d], {$GeoLocation[[1]], $GeoLocation[[2]]}}], 
d}, {d, 187, 365}, AspectRatio -> 1/1.6, PlotStyle -> Red];

p5 = ParametricPlot[{AstronomicalData[
"Jupiter", {"RightAscension", 
 DatePlus[Date[], d], {$GeoLocation[[1]], $GeoLocation[[2]]}}], 
d}, {d, 0, 365}, AspectRatio -> 1/1.6, PlotStyle -> Green];

Show[p1, p2, p3, p4, p5]

enter image description here

Then you've changed the problem to writing a piece of code which detects the discontinuities and changes the indices in the plots accordingly. I don't have a chance to do that at the moment but something which measures the distance between successive x-co-ords which stops once the difference is more than a certain threshold you set would get the job done. Mightn't be efficient or tidy but you could generate your plots in an automatic way at least.

fizzics
  • 791
  • 6
  • 15
  • 1
    detecting the discontinuities could be done with something like this: mf[d_?NumericQ]:=AstronomicalData["Mars",{"RightAscension",DatePlus[Date[],d],{$GeoLocation[[1]],$GeoLocation[[2]]}}]; NMinimize[mf[d], {d, 150, 160}] – sebhofer Oct 08 '12 at 09:47
  • 1
    Or even FindMinimum[Abs@mf[d], {d, 155}], which is faster, but less robust and more dependent on well chosen initial conditions. – sebhofer Oct 08 '12 at 09:52
  • This won't help unless in includes a way to locate the spots that need to be excluded. For example, I'd like to put this into a Manipulate were I can change things like the date range dynamically. – orome Oct 08 '12 at 13:30
  • @raxacoricofallapatorius I suggested a way to do this! It might not be the most convenient and robust method though... – sebhofer Oct 08 '12 at 14:14
3

Using ListLinePlot with Mesh, MeshFunctions, MeshFunctions and MeshShading options. The idea is to change the color of portions to be excluded to White.

First, the data:

 {dataMars, dataMercury, dataJupiter} = 
   Table[{AstronomicalData[#, {"RightAscension", DatePlus[Date[], d], 
      $GeoLocation[[;; 2]]}], d}, {d, 0, 365}] & /@ {"Mars", "Mercury", "Jupiter"};

Next, a function to pick the jumps in the first column of the data that exceed a threshold:

ClearAll[pickJumpsF];
pickJumpsF = Function[{data, threshold},
   With[{maxdif = Max@Abs@Differences[First /@ data],
         range = Abs[(Max@# - Min@#) &@(First /@ data)]},
   If[maxdif <= threshold range, {},
      First@Pick[Most@data[[All, 2]], Abs@Differences[First /@ data], maxdif]]]];

where a jump is defined as a point where the difference between two consecutive elements is greater than threshold times the range of the list.

Applying pickJumpsF with a threshold parameter .8 to the three data sets:

meshpoints = Sort@Flatten@{#, # + 1} &[pickJumpsF[#, .8] & /@ 
   {dataMars, dataMercury, dataJupiter} /. {} ->  Sequence[]]
(* {154, 155, 186, 187} *)

Now, we can plot all three data sets in a single ListLinePlot:

ListLinePlot[{dataMars, dataMercury, dataJupiter}, 
 Mesh -> {meshpoints},
 MeshStyle -> None, MeshFunctions -> (#2 &), 
 MeshShading -> {Automatic, None},
 PlotStyle -> {Directive[Thick, Blue], Directive[Thick, Red], Directive[Thick, Green]},
 ImageSize -> 450]

enter image description here

kglr
  • 394,356
  • 18
  • 477
  • 896
2

The trick is to use Split in a ListPlot to introduce breaks into the data at the offending points:

Show[     
 ListPlot[
  Split[
   {astroData["RightAscension", "Mars", #, $GeoLocation], #} & /@ Range[0, 365],
   (Abs[#2[[1]] - #1[[1]]] < 20) &
   ], PlotStyle -> Blue, AspectRatio -> 1/1.6, Joined -> True],     
 ListPlot[
  Split[
   {astroData["RightAscension", "Mercury", #, $GeoLocation], #} & /@ Range[0, 365],
   (Abs[#2[[1]] - #1[[1]]] < 20) &
   ], PlotStyle -> Red, AspectRatio -> 1/1.6, Joined -> True],     
 ListPlot[
  Split[
   {astroData["RightAscension", "Jupiter", #, $GeoLocation], #} & /@ Range[0, 365],
   (Abs[#2[[1]] - #1[[1]]] < 20) &
   ], PlotStyle -> Green, AspectRatio -> 1/1.6, Joined -> True],     
 PlotRange -> {{0, 24}, {0, 365}}]

(Using a function, astroData, defined elsewhere to speed things up a bit.)

enter image description here

Update: While Split alone works for certain kinds of plots, it will not work for ListPlot, for which splitting will introduce a gap between the points where the lists are split, and the edges of the plot. This is not pronounced for steep lines, but is dramatic for shallow ones:

ListPlot[
 Split[
  {astroData["RightAscension", "Moon", #, $GeoLocation], #} & /@ Range[0, 365], 
  (Abs[#2[[1]] - #1[[1]]] < 20) &], 
 PlotStyle -> Black, AspectRatio -> 1/1.6, Joined -> True,
PlotRange -> {{0, 24}, {0, 365}}]

enter image description here

One way to overcome this is to "pad" the introduced gaps with "duplicates" of the points across the gap, shifted outside the edge of the plot. This can be done for arbitrary lists of data with something like

wrapDataList[data_, xmin_, xmax_, xgap_ ] :=
 Split[ 
  ReplaceRepeated[data, 
   {h___, {x1_, y1_}, {x2_, y2_}, t___} 
   /; (Abs[(x2 - x1)] > xgap && x2 >= xmin && x1 <= xmax) ->
     {h, {x1, y1}, {x2 + (xmax - xmin), y2}, {x1 - (xmax - xmin), y1}, {x2, y2}, t}],
  (#2[[2]] > #1[[2]]) & ]

which gives:

ListPlot[
 wrapDataList[
  {astroData["RightAscension", "Moon", #, $GeoLocation], #} & /@ Range[0, 365],
  0, 24, 20],
 PlotStyle -> Black, Joined -> True,
PlotRange -> {{0, 24}, {0, 365}}]

enter image description here

Community
  • 1
orome
  • 12,819
  • 3
  • 52
  • 100
  • Since all of the answers (notably John's incomplete one) helped arrive at this, I'm making this CW. If someone wants to use this to improve their answer, I'll consider accepting that. Alternatively, please improve (or just vote up) this one so it can be taken as the answer. – orome Oct 08 '12 at 23:38
1

I don't how your data of each of your ParametricPlot looks like, but try to adapt the following:

Split[data, #1[[2]] != #2[[2]] &]
John
  • 4,361
  • 1
  • 26
  • 41
  • 2
    "I don't how your data of each of your ParametricPlot looks like..." - OP gave the code for producing the discontinuous plots. He wants the discontinuous plots to be made continuous, by stitching the two pieces together. – J. M.'s missing motivation Oct 08 '12 at 04:42
  • @J.M.
    I'm not familiar with AstronomicalData but maybe it is possible to produce the data via Table (i.e. wrapping AstronomicalData with Table) and then to use ListLinePlot with InterpolationOrder->3.     – John Oct 08 '12 at 04:50
  • That won't cure the problem OP has; the function itself has a (spurious) discontinuity that needs to be remedied. See this similar question. – J. M.'s missing motivation Oct 08 '12 at 05:09
1

One way is to first use Clip to keep all differences between consecutive data points within a given range, then reconstruct the list using Accumulate:

dataMars =  Table[{d, AstronomicalData["Mars", {"RightAscension", 
 DatePlus[Date[], 
  d], {$GeoLocation[[1]], $GeoLocation[[2]]}}]}, {d, 0, 365}]

dataFixed[data_, minDiff_, maxDiff_] := With[{diff = Differences[data[[All, 2]]]}, 
  Transpose[{data[[All, 1]], Accumulate[
    Join[{data[[1, 2]]}, Clip[diff, {minDiff, maxDiff}]]]}]]

dataMars2 = dataFixed[dataMars, 0.0394, 0.0559];
dataMercury2 = dataFixed[dataMercury, -0.08668, 0.1493437];
dataJupiter2 = dataFixed[dataJupiter, -0.00969, 0.01664];

ListLinePlot[{dataMars2, dataMercury2, dataJupiter2}]

enter image description here

b.gates.you.know.what
  • 20,103
  • 2
  • 43
  • 84