Как построить гистограмму с заштрихованным затенением?


21

я могу построить обычную гистограмму с синей штриховкой и черными границами, как это:

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

И я могу имитировать штриховки, как это:

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

Как я могу получить штриховки и черные границы на в то же время?

22

Я был уверен, что Histogram может быть изменен, чтобы иметь стиль штриховки. Немного поздно, но как насчет этого!

g[{{xmin_, xmax_}, {ymin_, ymax_}}, ___] := Module[{yval, line}, 
  yval = Range[ymin, ymax, 15]; 
  line = Line /@ [email protected]{[email protected]({xmin, #} & /@ yval),[email protected]({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, [email protected]}], Frame -> True] 

enter image description here

Проверить в функции, где yval определяется с Range[ymin, ymax, 15] можно изменить $15$ , чтобы изменить количество инкубационных. У вас также есть полный контроль примитива Graphics, используемого в ChartElementFunction, поэтому вы можете использовать еще много Directive, например Opacity и все.

BR

  0

Hah. То, что я собирался делать, но не хватило времени! +1 27 авг. 132013-08-27 15:43:39

  0

@rcollyer Thx! Хотя решение «Show» проще, я подумал о том, чтобы попробовать это решение. 27 авг. 132013-08-27 16:44:00

  0

Я тоже это поддержал, так как это сработало. Но у меня есть отвращение к запуску вещей более одного раза, если я могу помочь, если результат не будет резким ускорением, а метод «Show» запускает его дважды. 27 авг. 132013-08-27 17:05:40

  0

Это дважды «Show» заставил меня сделать это! 27 авг. 132013-08-27 17:20:49


16

Я хотел бы сделать что-то вроде:

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


11

Вы можете использовать PDF в виде HistogramDistribution для контура.

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

Проблема здесь состоит в том, что она не является частотная гистограмма, но гистограмма плотности.

Если вы хотите получить счет, вам нужно умножить на ширину и размер выборки.

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:

Если вы не хотите использовать HistogramDistribution вы также можете попробовать HistogramList.

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

14

Вот расширенная версия PlatoManiac's solution, которая позволяет изменять направление штриховки, а также настраивая расстояние между люками:

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 = [email protected]{{xstart, #} & /@ Most[yval], {xend, #} & /@ Rest[yval]}; 
    lines = Join[lines, {{{xstart, [email protected]}, 
      {xstart + ((xend - xstart) (ymax - [email protected]))/Abs[step], ymax}}}]; 
    {FaceForm[None], Rectangle[{xmin, ymin}, {xmax, ymax}], 
               CapForm["Butt"], Line[lines]}]; 

Теперь

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

дает

hist

И теперь можно объединить несколько гистограмм с различной штриховкой:

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

Гистограмма может быть оптимизирован путем соединения смежных отрезков в сплошные линии и удаления вспомогательных точек. Ниже приведен пример:

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} /. [email protected][{a x1 + b == y1, a x2 + b == y2}, {a, b}]; 
Show[hist2, 
Graphics[{[email protected] 
    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


1

Используя метод из this answer с помощью System'BarFunctionDump'TextureBar для параметра ChartElementFunction вместе с Texture как ChartStyle. Изображения, которые будут использоваться с Texture, создаются с использованием функции 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] 

Примеры:

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