21
$\begingroup$

I can plot an ordinary histogram with blue shading and black borders like this:

T = RandomVariate[NormalDistribution[0, 1], 10000];
Histogram[T, 30]

And I can simulate hatching like this:

T = RandomVariate[NormalDistribution[0, 1], 10000];
Histogram[T, 30, ChartElements -> Graphics[{Black, Line[{{0, 0}, {1, 1}}]}]]

How can I get the hatching and the black borders at the same time?

$\endgroup$
22
$\begingroup$

I was sure Histogram can be modified to have the hatching style. Little late but what about this!

g[{{xmin_, xmax_}, {ymin_, ymax_}}, ___] := Module[{yval, line},
  yval = Range[ymin, ymax, 15];
  line = Line /@ Transpose@{Most@({xmin, #} & /@ yval),Rest@({xmax, #} & /@ yval)};
  {FaceForm[White],Polygon[{{xmin, ymin}, {xmax, ymin}, {xmax, ymax}, {xmin, ymax}}],
   Orange, line}];
T = RandomVariate[NormalDistribution[0, 1], 10000];
Histogram[T, 30, ChartElementFunction -> g,
ChartBaseStyle -> EdgeForm[{Thin, Darker@Orange}], Frame -> True]

enter image description here

Check in the function where yval is defined with Range[ymin, ymax, 15] one can change the $15$ to change the amount of hatching. You also have total control of the Graphics primitive used in the ChartElementFunction so you can use many more Directive for example Opacity and all.

BR

$\endgroup$
  • $\begingroup$ Hah. What I was going to do, but ran out of time! +1 $\endgroup$ – rcollyer Aug 27 '13 at 15:43
  • $\begingroup$ @rcollyer Thx! TThough the Show based solution is simpler I thought of trying this solution. $\endgroup$ – PlatoManiac Aug 27 '13 at 16:44
  • $\begingroup$ I upvoted that one, too, as it worked. But, I have an aversion to running things more than once, if I can help it, unless the result is a dramatic speed-up, and the Show method runs it twice. $\endgroup$ – rcollyer Aug 27 '13 at 17:05
  • $\begingroup$ This twice thing of Show forced me to do this! $\endgroup$ – PlatoManiac Aug 27 '13 at 17:20
16
$\begingroup$

I would do something like:

t = RandomVariate[NormalDistribution[0, 1], 10000];
a = Histogram[t, 30, ChartStyle -> White];
b = Histogram[t, 30, 
  ChartElements -> Graphics[{Black, Line[{{0, 0}, {1, 1}}]}]];
Show[a, b]

enter image description here

$\endgroup$
14
$\begingroup$

Here is extended version of PlatoManiac's solution which allows changing of the direction of the hatching and also tuning the distance between hatches:

g[step_?NumberQ][{{xmin_, xmax_}, {ymin_, ymax_}}, ___] := 
  Module[{yval, lines, xstart, xend},
   yval = Range[ymin, ymax, Abs[step]];
   If[step > 0, {xstart, xend} = {xmin, xmax}, {xstart, xend} = {xmax, xmin}];
   lines = Transpose@{{xstart, #} & /@ Most[yval], {xend, #} & /@ Rest[yval]};
   lines = Join[lines, {{{xstart, Last@yval}, 
           {xstart + ((xend - xstart) (ymax - Last@yval))/Abs[step], ymax}}}];
   {FaceForm[None], Rectangle[{xmin, ymin}, {xmax, ymax}], 
                                               CapForm["Butt"], Line[lines]}];

Now

data = RandomVariate[NormalDistribution[0, 1], 10000];
Histogram[data, 30, "PDF", ChartElementFunction -> g[-.006], 
 ChartBaseStyle -> {Directive[{EdgeForm[{Thin, Black}], Black}]}, 
 Frame -> True]

gives

hist

And now one can combine several histograms with different hatchings:

data1 = RandomVariate[NormalDistribution[0, 1], 500];
data2 = RandomVariate[NormalDistribution[2, 1/2], 500];
h1 = Histogram[data1, 30, "PDF", ChartElementFunction -> g[.0260], 
   ChartBaseStyle -> Directive[{EdgeForm[{Thin, Black}], Black, Thin}], 
   Frame -> True];
h2 = Histogram[data2, 30, "PDF", ChartElementFunction -> g[-.0180], 
   ChartBaseStyle -> Directive[{EdgeForm[{Thin, Black}], Black, Thin}], 
   Frame -> True];
Show[h1, h2, PlotRange -> All, BaseStyle -> Antialiasing -> False]

2 hists

The histogram can be optimized by joining adjacent line segments into solid lines and deleting auxiliary points. Here is an example:

data = RandomVariate[NormalDistribution[0, 1], 100];
hist = Histogram[data, 30, "PDF", ChartElementFunction -> g[-.0160], 
  ChartBaseStyle -> {Directive[{EdgeForm[{Thin, Black}], Black}]}, Frame -> True];

hatchings = Cases[hist, (Line | LineBox)[{x__List}] /; Dimensions[{x}][[2]] == 2 :> x, {0, Infinity}];
hist2 = DeleteCases[hist, (Line | LineBox)[{x__List}] /; Dimensions[{x}][[2]] == 2, {0, Infinity}];

ClearAll[coeff, a, b, x1, x2, y1, y2];
coeff[{{x1_, y1_}, {x2_, y2_}}] /; x1 != x2 = {a, b} /. First@Solve[{a x1 + b == y1, a x2 + b == y2}, {a, b}];
Show[hist2, 
 Graphics[{Line@
    Flatten[Map[SortBy[Flatten[#, 1], Last][[{1, -1}]] &, 
      (Split[#, #1[[2]] == #2[[1]] || #1[[1]] == #2[[2]] &] & /@ 
        Gather[hatchings, coeff[#1] == coeff[#2] &]), {2}], 1]}]]

screenshot

$\endgroup$
11
$\begingroup$

You can use the PDF of a HistogramDistribution for the outline.

dist = HistogramDistribution[T, 30]

p1 = Plot[PDF[dist, t], {t, -4, 4}, PlotStyle -> Black, 
   Exclusions -> None, PlotPoints -> 100];

p2 = Histogram[T, 30, "PDF", 
   ChartElements -> Graphics[{Black, Line[{{0, 0}, {1, 1}}]}]];

Show[p1, p2]

enter image description here

The problem here is that it isn't a frequency histogram but a density histogram.

If you want to get counts you need to multiply by the bin width and sample size.

p1 = Plot[
  Differences[dist["BinDelimiters"]][[1]]*10^4*PDF[dist, t], {t, -4, 
   4}, PlotStyle -> Black, Exclusions -> None, PlotPoints -> 100]

enter image description here

Edit:

If you don't want to use HistogramDistribution you can also try HistogramList.

ListLinePlot[
 Thread[{Most[First[#]], Last[#]}] &[HistogramList[T, 30]], 
 InterpolationOrder -> 0, PlotStyle -> Black]
$\endgroup$
1
$\begingroup$

Using the method from this answer using System`BarFunctionDump`TextureBar for the option ChartElementFunction together with Texture as ChartStyle. Images to be used with Texture are created using the function hatchF.

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:

SeedRandom[123]
data1 = RandomVariate[NormalDistribution[0, 1], 10000];
data2 = RandomVariate[NormalDistribution[2, 1/2], 500];

Histogram[data1, 10, "PDF", 
 Frame -> True, ImageSize -> 500,
 ChartElementFunction -> System`BarFunctionDump`TextureBar, 
 ChartStyle -> Texture[hatchF[{# - #2 &}, {120}, Gray, PlotStyle -> None, 
    MeshShading -> {Gray, White}]]]

enter image description here

t1 = hatchF[{# - #2 &}, {80}, Gray, PlotStyle->Yellow, MeshShading -> {Gray, Automatic}];
t2 = hatchF[{# - #2 &, #2 + # &}, {50, 50}, Gray, ColorFunction -> "Rainbow", 
   MeshShading -> {{GrayLevel[.5], Automatic}, {Automatic, GrayLevel[.6]}}];
t3 = hatchF[{# - #2 &}, {80}, White, 
   MeshShading -> {GrayLevel[.5], Automatic}, ColorFunction -> "Rainbow"];
t4 = hatchF[{#2 + # &}, {90}, Blue, ColorFunction -> "DeepSeaColors"];

h1 = Histogram[data1, 10, "PDF", 
   ChartElementFunction -> System`BarFunctionDump`TextureBar, 
   ChartStyle -> Texture[t1], Frame -> True, ImageSize -> 400];
h2 = Histogram[data1, 10, "PDF", 
   ChartElementFunction -> System`BarFunctionDump`TextureBar, 
   ChartStyle -> Texture[t2], Frame -> True, ImageSize -> 400];

Row[{h1, h2}]

enter image description here

Histogram[{data1, data2}, 20, "PDF", 
  ChartElementFunction -> System`BarFunctionDump`TextureBar, 
  ChartStyle -> {Texture[t3], Texture[t4]},
  Frame -> True, ImageSize -> 500]

enter image description here

$\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.