0
$\begingroup$

I was plotting multiple discrete series on the same figure. Filling is needed to highlight trajectory of the series. However, if I use Filling->All, filling lines are overlapped.

One of the solution is to apply filling to only highlight most complicated parts of these series. I tried but failed to achieve this. I was wondering if there is a better solution.

The code I was using is

c = 0.002/12; b0 = 0; b1 = 0.1 c; b2 = 0.2 c; b3 = 0.3 c; b4 = 0.4 c; b5 = 0.5 c; b6 = 0.6 c; \[Omega] = 300; \[Nu] = 30000; 
m[t_, s_] := \!\(\*UnderoverscriptBox[\(\[Sum]\), \(j = 0\), \(t - s\)]\*FractionBox[\(\[Omega] \*SuperscriptBox[\((\(-b\))\), \(j\)]\), \(\((\[Nu] + \((t - j)\) \[Omega])\) \*SuperscriptBox[\((2 \((c - b)\))\), \(j + 1\)]\)]\); 
m0[t_, s_] := \[Omega]/((\[Nu] + t \[Omega]) (2 c));xticks = {10, 20, 30, 40, 50};
yticks = {10, 20, 30, 40};
age = 48; points = Range[48];
data1 = Transpose[{points, Table[m[age, s] /. b -> b6, {s, points}]}];
data2 = Transpose[{points, Table[m[age, s] /. b -> b4, {s, points}]}];
data3 = Transpose[{points, Table[m[age, s] /. b -> b2, {s, points}]}];
data4 = Transpose[{points, Table[m0[age, s], {s, points}]}];
Figurems = ListPlot[{data1, data2, data3, data4}, PlotRange -> All, Frame -> True, FrameLabel -> {"s", "\!\(\*SubscriptBox[\(m\), \(t, s\)]\)"}, BaseStyle -> {FontFamily -> "Arial", 8},PlotLegends -> Placed[PointLegend[{"b=0.6c", "b=0.4c", "b=0.2c", "b=0"}, LegendLayout -> "Row"], {0.5, 0}], FrameTicks -> {{yticks, {#, ""} & /@ yticks}, {xticks, {#, ""} & /@ xticks}}, PlotRange -> {{1, 100}, {10, 50}}, PlotMarkers -> {{\[FilledSquare], 6}, {\[FilledUpTriangle], 6}, {\[FivePointedStar], 6}, {\[FilledCircle], 4}}, Filling -> Axis]

My current figure is enter image description here

$\endgroup$
  • 1
    $\begingroup$ This is a great graphics, so what do you want? Actually I don't think I quite get your problem? Also, your code is not runable, please provide necessary constants. $\endgroup$ – Wjx Jun 15 '16 at 9:34
  • $\begingroup$ Thanks. Parameter values have been added. The code should work now. My concern is that, these vertical lines created by filling overlap with each other. It is not goodlooking. $\endgroup$ – David Xiaoyu Xu Jun 15 '16 at 11:21
  • $\begingroup$ So you want them to be seperated in order to show all the lines? $\endgroup$ – Wjx Jun 15 '16 at 11:40
  • $\begingroup$ That's one possibility. I was also considering keeping lines for only one series (b=0.6c) and suppressing lines of the other three series. $\endgroup$ – David Xiaoyu Xu Jun 15 '16 at 13:47
  • $\begingroup$ Filling to the axis seems like an odd choice here, have you tried something like, Show[ListPlot[{data1,data2,data3,data4},Joined->True],ListPlot[{data1,data2,data3,data4},Joined->False]? $\endgroup$ – N.J.Evans Jun 15 '16 at 20:51
2
$\begingroup$

Here are two solutions:

The first is as you've said: only fill the second curve. The second is a bit more complicated: make the point move a bit and make the line distinct~ I'll use sample data like the following to get a maximized variety:

data = {Table[N@10 Sin[i], {i, 10}], 
Table[{i, N@10 Sin[i] + 1}, {i, 1, 10, 1/2}], 
Table[{i - .2, N@10 Sin[i] - 1}, {i, 1, 10, 1/2}]};

The original graph is like this:

 (*Original Plot*)
 ListPlot[data, Filling -> Axis, PlotLabel -> "ORIG", 
 PlotLegends -> {1, 2, 3}]

orig

We can make some small adjustments to fill only the second curve:

(*Only Fill 2*)
ListPlot[data, Filling -> {2 -> Axis}, PlotLabel -> "FILL 2", PlotLegends -> {1, 2, 3}]

And the result looks like:

only 2

But I suppose the following code is the best in appearance:

(*Make Overlap disappear*)

Module[{dat = 
SortBy[GatherBy[
Flatten[MapIndexed[Thread[{First@#2, #1}] &, proc /@ data], 
1], #[[2, 1]] &], #[[1, 2, 1]] &]},
ListPlot[
GatherBy[
Flatten[MapThread[{#[[1]], {#[[2, 1]] + #2, #[[2, 2]]}} &, {#, 
     Min[Rest@# - Most@# &@
         dat[[;; , 1, 2, 1]]]/(3 Max[Length /@ dat]) Range[0, 
       Length@# - 1]}] & /@ dat, 1], First][[;; , ;; , 2]], 
Filling -> Axis, PlotLabel -> "NO OVERLAP", 
PlotLegends -> {1, 2, 3}]]

I suppose this is just what you need?

final

It successfully make overlapping disappear while preserved all the filling lines~

Will this help?

| improve this answer | |
$\endgroup$
  • $\begingroup$ This looks great! Thanks! $\endgroup$ – David Xiaoyu Xu Jun 16 '16 at 9:54
  • $\begingroup$ @DavidXiaoyuXu :) glad to help~ $\endgroup$ – Wjx Jun 16 '16 at 10:47
  • $\begingroup$ @DavidXiaoyuXu 话说你中文名是啥?让我回想起了某位我的同学…… $\endgroup$ – Wjx Jun 16 '16 at 10:52
  • $\begingroup$ 应该是重名吧…我没有认识的人大附毕业的同学 $\endgroup$ – David Xiaoyu Xu Jun 16 '16 at 13:35
  • $\begingroup$ @DavidXiaoyuXu 好吧…… $\endgroup$ – Wjx Jun 16 '16 at 23:18
1
$\begingroup$

My suggestion would be to use include the Joined->True directive. This has the effect of changing the filling style from vertical line segments to uniform coloring:

Mathematica graphics

Also, since nothing much happens for the first half of the data, you may consider plotting only the second half:

Mathematica graphics

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

you can define your own customized plotting function for that.

bar[col_, thickness_,  opc_, marker_, size_, data_] := {col, Opacity[opc],
   Thickness[thickness], Line[{{#[[1]], 0}, #}], Opacity[1], 
   Text[Style[marker, size], #]} & /@ data

Now you can plot lines with different thickness and opacity to make all of them visible.

Graphics[{
  bar[Blue, 0.01, \[FilledSquare], 10, 0.5, data1], 
  bar[Green, 0.007, \[FilledUpTriangle], 10, 0.5, data2], 
  bar[Red, 0.005, \[FilledCircle], 10, 0.5, data3]},
Frame -> True, FrameLabel -> {"s", "mts"}, 
FrameTicks -> {{yticks, {#, ""} & /@ yticks}, {xticks, {#, ""} & /@ 
xticks}}, PlotRange -> All, AspectRatio -> 1/2]

enter image description here

| improve this answer | |
$\endgroup$

Not the answer you're looking for? Browse other questions tagged or ask your own question.