Adjusting number of symbols for each function to plot in B&W

Question

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:

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

My other graphing program generates:

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.

Answer 1

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

Answer 2

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

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.

Answer 3

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

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 :

You may not have this problem.

Answer 4

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]

Answer 5

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]

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.