7
$\begingroup$

I am producing a graphic that is mostly black lines on a white background but I need to identify some areas of the graph that belong to two phenomena and I currently use a blue and a red shade for those. Because the result would likely be published in a paper-based scientific journal, I would like to have the option to produce a graph that does not require color. I could try using two light GrayLevels (the shaded areas have text on them so for legibility I cannot use dark) but I was wondering if the community has some other proposed solution. Perhaps one area could be dotted and the other lined or something along those notions. I am looking for the code that would produce a dotted or lined surface with ease similar to setting the colors with an RGBColor command. I should add that the result should not change as I resize the graph since I use one size for screen resolution and a much larger size for print resolution. So, when I produce the larger image the hatching/shading/doting should also scale analogously.

A simplified example of the code and the graphic would be

Graphics[{
  GrayLevel[.8],
  Disk[{0, 0}, {1, 1}, {π, 3 π/4}],
  Disk[{0, 0}, {1, 1}, {π/8, 3 π/12}],
  GrayLevel[.6],
  Disk[{0, 0}, {1, 1}, {0, π/8}],
  Disk[{0, 0}, {1, 1}, {3 π/2, 3.3 π/2}],
  Black,
  Circle[],
  Text["Area 1", {.5, .1}],
  Text["Area 2", {.5, .3}],
  Text["Area 3", {-.5, .2}],
  Text["Area 4", {.15, -.6}]
}]

Mathematica graphics

$\endgroup$
  • $\begingroup$ Could you show the code generating the area? Different techniques would apply depending on how you generate your graphics. Have you had a search of this site? Perhaps these could be interesting: Hatched bars and bar-specific background in BarChart, How do I plot a histogram with hatched shading?, Filling a polygon with a pattern of insets. $\endgroup$ – MarcoB Jun 26 '17 at 14:20
  • $\begingroup$ @MarcoB thanks for pointing to those examples, I had not found them. I do not understand the code but I think it requires a bar graph, which mine, as you see, is not. $\endgroup$ – Nicholas G Jun 26 '17 at 18:38
  • 2
    $\begingroup$ Also related: "Generating hatched filling using Region functionality" $\endgroup$ – Alexey Popkov Jun 26 '17 at 23:18
  • $\begingroup$ Note that if you resize the image using ImageSize (for the higher resolution), the text will not be resized. So regarding "the result should not change when I resize the graph", it already does – unless you have some other means of resizing it in mind. $\endgroup$ – C. E. Jun 27 '17 at 0:49
  • 1
    $\begingroup$ I use ImageSize 6x57 and FontSize 12 for screen and 6x200 and 42 for publishing. $\endgroup$ – Nicholas G Jun 27 '17 at 0:52
8
$\begingroup$

It can be done in several ways, but, I am afraid, none of them with ease similar to setting the colors with an RGBColor command:)

1. Using Show and ParametricPlot with different Mesh* settings

Create four different ParametricPlot each with different settings for the Mesh* options and use Show to put them together:

ClearAll[meshedParametricPlot]
meshedParametricPlot = ParametricPlot[#2 {r Cos[t] ,  r Sin[t]} + #, 
    {t, #3[[1]], #3[[2]]}, {r, 0, 1}, 
    MeshFunctions -> #4, Mesh -> {#5}, MeshStyle -> Gray, 
    PlotStyle -> White, BoundaryStyle -> GrayLevel[.8], PlotPoints -> 200] &;

{p1, p2, p3, p4} = meshedParametricPlot @@@ 
    {{{0, 0}, {1, 1}, {3 π/4, π}, {# - #2 &, # + #2 &}, 20}, 
     {{0, 0}, {1, 1}, {π/8, 3 π/12}, {#3 &}, 15}, 
     {{0, 0}, {1, 1}, {0, π/8}, {#4 &},  20},
     {{0, 0}, {1, 1}, {3 π/2, 3.3 π/2}, {#2 &}, 20}};

labels = {Text[Style["Area 1", FontSize -> Scaled[.04]], {.6, .1}], 
   Text[Style["Area 2", FontSize -> Scaled[.04]], {.7, .5}], 
   Text[Style["Area 3", FontSize -> Scaled[.04]], {-.5, .2}], 
   Text[Style["Area 4", FontSize -> Scaled[.04]], {.15, -.6}]};

Show[p1, p2, p3, p4, PlotRange -> {{-1, 1}, {-1, 1}}, 
 AspectRatio -> 1, Frame -> False, Axes -> False, Epilog -> {Circle[], labels}]

Mathematica graphics

The disk slices can have different centers and radii:

{p1, p2, p3, p4} = meshedParametricPlot @@@ 
       {{{-.25, .1}, {1, 1}, {3 π/4, π}, {# - #2 &, # + #2 &}, 20}, 
       {{0, 0}, {2, 2}, {π/8, 3 π/12}, {#3 &}, 15}, 
       {{0, 0}, {1, 1}, {0, π/8}, {#4 &}, 20}, 
       {{-.25, 0}, {2, 2}, {3 π/2, 3.3 π/2}, {#2 &}, 20}};

Show[p1, p2, p3, p4, PlotRange -> {{-2.5, 2.5}, {-2.5, 2.5}}, 
    AspectRatio -> 1, Frame -> False, Axes -> False, 
    Epilog -> {Circle[], PointSize[Large], Point[{0, 0}], Circle[{0, 0}, 2], labels}]

Mathematica graphics

2. Using Graphics with Texture

First, a function to create texture patterns using ParametricPlot and combinations of Mesh* options:

ClearAll[hatchF]
hatchF[mf_List: {# &, #2 &}, mesh_List: {50, 50}, style_: GrayLevel[.5], 
  opts : OptionsPattern[]] := ParametricPlot[{x, y}, {x, 0, 1}, {y, 0, 1},
  Mesh -> mesh, MeshFunctions -> mf, MeshStyle -> style, BoundaryStyle -> None, 
  opts, Frame -> False, PlotRangePadding -> 0, ImagePadding -> 0, Axes -> False]

Examples:

t0 = hatchF[{Sin[10 #2 ] + Cos[5 # ] &, (Sin[10 # ] + Cos[10 #2])  &}, {5, 5}, 
 Directive[ Thick, White], 
 MeshShading -> Dynamic@{{GrayLevel@RandomReal[{.7, .8}], White}, 
   {Hue@RandomReal[], Hue@RandomReal[]}}]

Mathematica graphics

{t1, t2, t3, t4} = hatchF[#, {#2}, White, 
     MeshShading -> Dynamic@{GrayLevel@RandomReal[{.7, .8}], White}] & @@@ 
 {{{ # - #2 &}, 20}, {{ Norm[{#, #2}] &}, 40}, {{ # &}, 10}, {{#2 &}, 20}};
t5 = hatchF[{# - #2 &, #2 + # &}, {20}, Gray, PlotStyle -> None];
t6 = hatchF[{ Norm[{#, #2}] &}, {40}, Gray, PlotStyle -> None];
t7 = hatchF[{# &, #2 &}, {20}, Gray, PlotStyle -> None];
t8 = hatchF[{ # &}, {30}, Gray, PlotStyle -> None];
t9 = hatchF[{ #2 &}, {30}, Gray, PlotStyle -> None];
Row[{t1, t2, t3, t4, t5, t6, t7, t8, t9}, Spacer[5]]

Mathematica graphics

We can use Texture for styling Polygons directly:

SeedRandom[9]
coords = RandomInteger[10, {10, 2}];
Graphics[{EdgeForm[Black], Texture[t0], 
  Polygon[coords, VertexTextureCoordinates -> Rescale[coords]]}]

Mathematica graphics

For disk primitives we need to transform Disks to polygons and then texture them:

ClearAll[diskToCoords, texturedPolygon]
diskToCoords[n_] := Module[{angles = Sort@N@#3}, 
    Prepend[Table[#2 {Cos[i], Sin[i]} + #, {i, angles[[1]], angles[[2]], 
    (Subtract @@ Reverse[angles])/n}], #]] &;

texturedPolygon[t_, n_] := Module[{coords = diskToCoords[n] @@ #}, 
    {Texture[t], Polygon[coords, VertexTextureCoordinates -> Rescale[coords]]}] &

Examples:

disk1 = Disk[{0, 0}, {1, 1}, {π, 3 π/4}];
disk2 = Disk[{0, 0}, {1, 1}, {π/8, 3 π/12}];
disk3 = Disk[{0, 0}, {1, 1}, {0, π/8}];
disk4 = Disk[{0, 0}, {1, 1}, {3 π/2, 3.3 π/2}];

Graphics[{texturedPolygon[t1, 40]@disk1, 
  texturedPolygon[t2, 40]@disk2, texturedPolygon[t3, 40]@disk3, 
  texturedPolygon[t4, 40]@disk4, Black, Circle[], labels}]

Mathematica graphics

Graphics[{texturedPolygon[t5, 40]@disk1, 
  texturedPolygon[t6, 40]@disk2, texturedPolygon[t7, 40]@disk3, 
  texturedPolygon[t9, 40]@disk4, Black, Circle[], labels}]

Mathematica graphics

Again, disk slices can have different origins and radii:

disks = {Disk[{-.25, .25}, {1, 1}, {π, 3 π/4}], 
         Disk[{0, 0}, {2, 2}, {π/8, 3 π/12}], 
         Disk[{0, 0}, {1, 1}, {0, π/8}], 
         Disk[{-.25, 0}, {2.5, 2.5}, {3 π/2, 3.3 π/2}]};

Graphics[{Circle[], Circle[{0, 0}, 2], 
   texturedPolygon[#, 40][#2] & @@@ Transpose[{{t5, t2, t1, t0}, disks}]}]

Mathematica graphics

3. Using ParametricPlots with Texture as PlotStyle

texturedParametricPlot = ParametricPlot[#2 {r Cos[t] , r Sin[t]} + #, 
    {t, #3[[1]], #3[[2]]}, {r, 0, 1}, 
    Mesh -> None, PlotStyle -> Directive[Opacity[1], Texture[#4]], 
    BoundaryStyle -> GrayLevel[.8], PlotPoints -> 200, 
    TextureCoordinateFunction -> ({#, #2} &)] &;

 {p1b, p2b, p3b, p4b} = texturedParametricPlot @@@ 
     {{{0, 0}, {1, 1}, {3 π/4, π},  t5},
     {{0, 0}, {1, 1}, {π/8, 3 π/12},  t6}, 
     {{0, 0}, {1, 1}, {0, π/8}, t8}, 
     {{0, 0}, {1, 1}, {3 π/2, 3.3 π/2}, t9}};

Show[p1b, p2b, p3b, p4b, PlotRange -> {-1, 1}, AspectRatio -> 1, 
 Frame -> False, Axes -> False, Epilog -> {Circle[], labels}]

Mathematica graphics

The disk slices may have different origins and radii:

{p1c, p2c, p3c, p4c} =  texturedParametricPlot @@@ 
   {{{-.25, .25}, {1, 1}, {3 π/4, π}, t5}, 
    {{0, 0}, {2, 2}, {π/8, 3 π/12}, t6}, 
    {{0, 0}, {1, 1}, {0, π/8}, t8}, 
    {{-.25, 0}, {2, 2}, {3 π/2, 3.3 π/2}, t9}};

Show[p1c, p2c, p3c, p4c, PlotRange -> {{-2.5, 2.5}, {-2.5, 2.5}}, 
    AspectRatio -> 1, Frame -> False, Axes -> False, 
    Epilog -> {Circle[], Circle[{0, 0}, 2], PointSize[Large], Point[{0, 0}]}]

Mathematica graphics

4. Using PieChart with Texture and custom ChartElementFunction

ClearAll[ceF1]
ceF1[{{t0_, t1_}, {r0_, r1_}}, _, meta___List] := 
  Module[{txtr = If[meta === {}, White, Texture[meta[[1]]]]}, 
   ParametricPlot[{r Cos[t], r Sin[t]}, {t, t0, t1}, {r, r0, r1}, 
     Mesh -> None, BoundaryStyle -> Gray, PlotStyle -> txtr, 
     TextureCoordinateFunction -> ({#, #2} &)][[1]]];

 piechartdata = -Subtract @@@ 
    Partition[Sort[N@{0, π, 3 π/4, π/8, 3 π/12, 3 π/2, 3.3 π/2, 2 π}], 2, 1];

PieChart[{Labeled[piechartdata[[1]], labels[[1, 1]]] -> t1, 
  Labeled[piechartdata[[2]], labels[[2, 1]], "RadialCallout"] -> t2, 
  piechartdata[[3]], Labeled[piechartdata[[4]], labels[[3, 1]]] -> t3,
   piechartdata[[5]], Labeled[piechartdata[[6]], labels[[4, 1]]] -> t4, 
  piechartdata[[7]]}, 
 ChartElementFunction -> ceF1, SectorOrigin -> {{0}, .5}]

Mathematica graphics

You can use the same ChartElementFunction with SectorChart to have different radii for different pie slices:

SectorChart[{Labeled[{piechartdata[[1]], 1}, labels[[1, 1]], RadialCallout"] -> t1, 
  Labeled[{piechartdata[[2]], 2}, labels[[2, 1]], "RadialCallout"] -> t2, 
  {piechartdata[[3]], 0}, 
  Labeled[{piechartdata[[4]], 3}, labels[[3, 1]]] -> t3, 
  {piechartdata[[5]], 0}, 
  Labeled[{piechartdata[[6]], 3}, labels[[4, 1]]] -> t4, 
  {piechartdata[[7]], 0}}, ChartElementFunction -> ceF1, 
 SectorOrigin -> {{0}, .5}]

Mathematica graphics

5. Using PieChart with Mesh lines and custom ChartElementFunction

The following custom function creates pie slices with mesh lines based on parameters that can be passed as meta information associated with each data point:

ClearAll[ceF2]
ceF2[{{t0_, t1_}, {r0_, r1_}}, _, meta___List] := 
  Module[{mf = If[meta === {}, {}, meta[[1, 1]]], mesh = If[meta === {}, {}, meta[[1, 2]]]}, 
   Dynamic@ParametricPlot[{r Cos[t], r Sin[t]}, {t, t0, t1}, {r, r0,  r1}, 
  MeshFunctions -> mf, Mesh -> mesh, MeshStyle -> White, 
      BoundaryStyle -> Gray, 
      PlotStyle -> Directive[Opacity[.9], CurrentValue["Color"]]][[1]]];

Examples:

PieChart[{Labeled[piechartdata[[1]], labels[[1, 1]], 
    "RadialCallout"] -> {{#1 &, #1 - #2 &}, {5, 5}}, 
  Labeled[piechartdata[[2]], labels[[2, 1]]] -> {{#1 - 2 #2 &}, {10}},
  Style[piechartdata[[3]], White], 
  Labeled[piechartdata[[4]], labels[[3, 1]]] -> {{#4 &}, {10}}, 
  Style[piechartdata[[5]], White], 
  Labeled[piechartdata[[6]], labels[[4, 1]], "RadialCallout"] -> {{#3 &}, {5}}, 
  Style[piechartdata[[7]], White]}, 
  ChartElementFunction -> ceF2, SectorOrigin -> {{0}, 1}, ChartStyle -> "Pastel" , 
  ImagePadding -> 10]

Mathematica graphics

Using it with SectorChart with appropriate input data:

SectorChart[{Labeled[{piechartdata[[1]], 1}, labels[[1, 1]], 
    "RadialCallout"] -> {{#1 &, #1 - #2 &}, {5, 5}}, 
  Labeled[{piechartdata[[2]], 3}, labels[[2, 1]]] -> {{#1 - 2 #2 &}, {10}},
  {piechartdata[[3]], 0}, 
  Labeled[{piechartdata[[4]], 2}, labels[[3, 1]]] -> {{#4 &}, {10}}, 
  {piechartdata[[5]], 0}, 
  Labeled[{piechartdata[[6]], 3}, labels[[4, 1]], "RadialCallout"] -> {{#3 &}, {5}}, 
  {piechartdata[[7]], 0}}, 
 ChartElementFunction -> ceF2, SectorOrigin -> {{0}, 1}, 
 ChartStyle -> "Pastel" , PlotRangePadding -> 0]

Mathematica graphics

$\endgroup$
  • $\begingroup$ thanks, I like these results but, because my graphs are quite a bit more complex, the implementation is a bridge too far for me for now. However, given the sophistication of all this programming, my sense is that you are only a couple of steps away from some function surfaceTreatment[ graphics primitive, surface treatment choice] that would make all this easy to handle. $\endgroup$ – Nicholas G Jun 28 '17 at 22:48
  • $\begingroup$ Your improved code is really impressive, many thanks! The problem is that my Disk slices do not all have the same center and diameter. They look more like pizza slices arranged outside the pizza box. Thus your improved code is one millimeter away from being directly applicable. But I feel that you could make your code apply to any graphic primitive, no? The next user will not be using Disks. $\endgroup$ – Nicholas G Jun 29 '17 at 0:11
  • 1
    $\begingroup$ @NicholasG, i updated with examples of how the Texture and ParametricPlot approaches can handle disk slices with different radii and origins. I think the approach using PieChart can also be modified to handle the general case. Regarding "any graphic primitive", Disk happens to be difficult case as Texture doesn't work with Disk. Polygon primitives does not require any additional processing before applying Texture. $\endgroup$ – kglr Jun 29 '17 at 1:46

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.