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

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.

• 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. – QuantumBrick Aug 29 '16 at 20:53
• @andre, sorry I didnt get to see your answer. Why was 'Mesh' a bad idea? – ivbc Aug 30 '16 at 13:58
• @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) – andre314 Aug 30 '16 at 17:44

Show[
DiscretePlot[
#[], {x, 0, 10, 10/(#[] - 1)},
PlotStyle -> Directive[#[], Opacity[.75]],
PlotMarkers -> {#[], 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}]] 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.

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.

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

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] 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[#[], {x, Range[0, 6, 2] + #[]/3},
PlotStyle -> Directive[#[], Opacity[.75]],
PlotMarkers -> {#[], 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.