5
$\begingroup$

Today I need your help to get some graphics to look good.

I have a few functions obtained from NDSolve that I want to plot, with 'Plot' (preferrably). I need to add symbols so that the graph is clear even in black & white, and the symbols shold NOT overlap at every position (my other graphing program changes this with the command "symbol frequency").

For example lets do:

DiscretePlot[{x, Sqrt[x^2 + 1]}, {x, 0, 10, .5}, 
  Joined -> True, 
  Filling -> None, 
  PlotMarkers -> {Automatic, 9}, 
  PlotStyle -> Opacity[.999], 
  PlotLegends -> "Expressions"]

We obtain:

Mathematica's result

Notice that the symbols overlap a lot at the right corner.

My other graphing program generates:

My goal

Is there a way to obtain a symilar result with Mathematica?

Edit: very symilar problem. Here ubpdqn's solution was interesting, but he used colors tho differ the two functions. In B&W it will not work.

$\endgroup$
  • $\begingroup$ The graphs will overlap if the functions overlap. If you want both graphs to be clearly distinguishable from one another try reading the PlotMarkers documentation. $\endgroup$ – QuantumBrick Aug 29 '16 at 20:53
  • $\begingroup$ @andre, sorry I didnt get to see your answer. Why was 'Mesh' a bad idea? $\endgroup$ – ivbc Aug 30 '16 at 13:58
  • $\begingroup$ @ivbc I have undeleted my answer. It has been heavily changed. The good new is that this version may be interesting for you (Though complicated) $\endgroup$ – andre314 Aug 30 '16 at 17:44
2
$\begingroup$
Show[
 DiscretePlot[
    #[[1]], {x, 0, 10, 10/(#[[2]] - 1)},
    PlotStyle -> Directive[#[[3]], Opacity[.75]],
    PlotMarkers -> {#[[4]], 18},
    Joined -> True,
    Filling -> None] & /@ {
    (* {func, nbr of markers, color, marker) *)
   {x, 8, Red, "□"}, 
   {Sqrt[x^2 + 1], 18, Blue, "○"}},
 Epilog -> Inset[
   LineLegend[{Red, Blue}, {x, Sqrt[x^2 + 1]},
    LegendMarkers -> {{"□", 18}, {"○", 18}}],
   {8.5, 3.5}]]

enter image description here

$\endgroup$
2
$\begingroup$

You may use ListPlotand build your data series such that each one has a slight offset from the other.

ListPlot[
 Function[{v}, {v, #1 /. x -> v}, Listable]@#2 &[
    First@#, Union[{0., 10.}, Range[#, 10., .5]] &@Last@#
    ] & /@
  {
   {x, 0.},
   {Sqrt[x^2 + 1], .1}
   },
 Joined -> True, PlotMarkers -> Automatic,
 PlotLegends -> {x, Sqrt[x^2 + 1]}
 ]

enter image description here

The above chains a couple of pure functions together. Reading from the top down.

The first uses Function to create a Listable pure-function that contains the plot-function which acts on the list of x-values to get the pairs for ListPlot. This pure-function is mapped over the plot-function and the list of x-values.

The second pure-function takes the plot-function and calculates the x-values using the supplied offset. 0 and 10 are Unioned in to ensure the plot range is covered by all of the plot-functions. This pure-function is mapped over the list of plot-function and offset pairs.

Hope this helps.

$\endgroup$
2
$\begingroup$

This is a solution compatible with a Black & White rendering :

myOptions = {Filling -> None, PlotLegends -> LineLegend[
"AllExpressions", LegendMarkers -> Graphics[Point[{0, 0}]]]};   

gr10 = Plot[x, {x, 0, 10}, Evaluate @ myOptions,
   Mesh -> {Range[0,8]}, 
   MeshStyle -> Directive[Red, PointSize[0.02]], 
   PlotStyle -> Directive[Opacity[.999], Red]];  

gr11 = Plot[Sqrt[x^2 + 1], {x, 0, 10}, Evaluate @ myOptions, 
   Mesh -> {0.5 + Range[0,8]}, 
   MeshStyle -> Directive[Blue, PointSize[0.02]], 
   PlotStyle -> Directive[Opacity[.999], Blue]];

(* marker are regular polygons with n sides *)
marker[color_, n_] := Inset[
Graphics[
 {color, Line[{Cos[#], Sin[#]} & /@ (2. Pi Range[-1/4-1/(2 n),3/4-1/(2 n),1/n])]}
   , ImageSize -> 12]
,{0, 0}];

Style[Show[
  Normal[gr10] /. Point[x_] :> Translate[ marker[Red, 5], x],
  Normal[gr11] /. Point[x_] :> Translate[ marker[Blue, 3], x]
  ],
GridBoxOptions -> {GridBoxDividers -> None}] 

![enter image description here

This solution will replace all the primitivesPoint[]present in the graphics by a marker.
Therefore do not use the primitive Point[] for something else (in a Epilog-> ... for example)

For this answer a lot of stuff has been borrowed to other Mathematica Stack Exchange answers.

Subtleties and links to the Mathematica Stack Exchange explanations :

  • Use of PlotLegends -> ..."AllExpressions" and not PlotLegends -> ..."Expressions" :
    see here

  • Why generating gr10 and gr11 separatly ?

    • because it is not possible to have something else than Point[] as mesh marker

    • because it is not possible to plot several curves with respectively distinct mesh position in a single Plot[{curve1[x],curve2[x]...},...]

    see here

  • why use Inset[] for the marker ?

    because the dimensions of the markers must be independent of the PlotRange/AspecRatio/Size of the final rendering

  • why Style[...,GridBoxOptions -> {GridBoxDividers -> None}] ?

because otherwise, I obtain this :

enter image description here

You may not have this problem.

$\endgroup$
  • $\begingroup$ Quite complicated indeed! Plenty of stuff for me to learn from. +1 for the links and explanations! $\endgroup$ – ivbc Aug 31 '16 at 1:45
  • $\begingroup$ @ivbc Clearly too much to learn for such a simple problem. Feel free to give up ! $\endgroup$ – andre314 Aug 31 '16 at 2:37
1
$\begingroup$

This is an exaggerated example to illustrate some potential paths to what is wanted.

pm1 = Graphics[
   Table[{EdgeForm[{Black, Thick}], FaceForm[None], 
      Translate[Rectangle[], {j, 0}]}, {j, 0, 3, 1.5}]~
    Join~{Line[{{-1, 1/2}, {5, 1/2}}]}];
pm2 = Graphics[
   Table[{EdgeForm[Black], FaceForm[None], 
      Translate[Circle[], {j, 0}]}, {j, 0, 5, 2.5}]~
    Join~{Line[{{-2, 0}, {7, 0}}]}];
leg = SwatchLegend[{Red, Blue}, {"x", TraditionalForm[Sqrt[x^2 + 1]]},
    LegendMarkers -> {pm1, pm2}, 
   LegendMarkerSize -> {{100, 20}, {100, 25}}];
DiscretePlot[{x, Sqrt[x^2 + 1]}, {x, 0, 10, .5}, Joined -> True, 
 Filling -> None,

 PlotStyle -> {Red, Blue}, 
 PlotMarkers -> {{Graphics[{EdgeForm[Black], FaceForm[None], 
      Rectangle[]}], 0.1}, {Graphics[Circle[]], 0.1}}, 
 PlotStyle -> Opacity[.999], PlotLegends -> leg]

enter image description here

$\endgroup$
0
$\begingroup$

Thank you guys for all the answers. All were very helpfull and taught me something. Based on Bob Hanlon's and Edmund's answers I came up with this function:

goodLookingPlot[functions_List] := 
Block[{t, legend, collors, markers, toPlot}, (

t = Table[i, {i, Length@functions}];
dummyPlot = 
 DiscretePlot[Evaluate@t, {x, 0, 1, .5}, Joined -> True, 
  PlotTheme -> "Scientific", ImageSize -> Large, Filling -> None, 
  PlotMarkers -> {Automatic, 15}, PlotStyle -> Opacity[.999], 
  PlotLegends -> 
   LineLegend[functions, LegendLayout -> {"Column", 2}, 
    LegendMarkerSize -> 18, Spacings -> {0.2, 0.2}]];

legend = dummyPlot[[2, 1]];
markers = 
 Table[dummyPlot[[1, 1, 1, 2, i, 1, 2, 3, 1, 1]], {i, 
   Length@dummyPlot[[1, 1, 1, 2]]}];
collors = 
 Table[dummyPlot[[1, 1, 1, 2, i, 1, 1, 2]], {i, 
   Length@dummyPlot[[1, 1, 1, 2]]}];

toPlot = 
 Table[{functions[[i]], i, collors[[i]], markers[[i]]}, {i, 
   Length@functions}];

Return@
 Show[Plot[functions, {x, 0, 10}, PlotTheme -> "Scientific", 
   ImageSize -> Large], 
  DiscretePlot[#[[1]], {x, Range[0, 6, 2] + #[[2]]/3}, 
     PlotStyle -> Directive[#[[3]], Opacity[.75]], 
     PlotMarkers -> {#[[4]], 25}, Filling -> None, 
     PlotTheme -> "Scientific", ImageSize -> Large] & /@ toPlot,
  Epilog -> Inset[legend, {9, 2}]]
);]

So the command bellow gives the following result:

func = Prepend[Table[(2 i + x^2)^(1/2), {i, 0, 4}], x];
goodLookingPlot[func]

A good looking plot

Notice that two curves overlap completely, but their symbols make it clear that we have six curves here and not five.

I used both 'Plot' and 'DiscretePlot'. The first was to get the curves to look smooth without clutering the graph with too many symbols. The second was added to make sure I had a few symbols there.

I am not proud for using "dummyplot" to steal its legend, symbols and collors. I opted to do so so that I could keep using Mathematica's automatic styles.

$\endgroup$

Your Answer

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

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