SmoothDensityHistogramのMeshFunction
Oct 22 2020
SmoothDensityHistogram特定の(同心)領域内の確率レベルも視覚化できるデータセットを作成したいと思います。コードは次のとおりです。
somePoints =
RandomReal[BinormalDistribution[{-2, 2}, {1, 1}, .8], 1000];
SmoothDensityHistogram[somePoints,
Automatic, "PDF",
ColorFunction -> "DarkBands",
BaseStyle -> {FontSize -> 34, FontFamily -> "Arial"},
FrameStyle -> Directive[Black, AbsoluteThickness[3]],
ImageSize -> 800,
AspectRatio -> 0.5,
PlotRange -> All,
MeshStyle -> Black,
Mesh -> 5]
私が抱えている問題は、各メッシュラインで囲まれた確率をプロット上のラベルで直接示すことです(これと同様ContourPlotです)。調べてMeshFunctionいますが、探している結果に到達できません。理想的には、プロットされるメッシュラインを決定することもできます(たとえば、60%と80%の確率に対応します)。
編集
私もここで説明されているアプローチを試しました:
SmoothDensityHistogram上の等高線
メッシュラインの識別に適しています。ただし、それらが取り囲む確率(例では20、40、60、および80%)に従ってそれらにラベルを付ける方法をまだ理解できません。
RandomReal[BinormalDistribution[{-2, 2}, {1, 1}, .8], 1000];
d = SmoothKernelDistribution[somePoints];
Show[SmoothDensityHistogram[somePoints,
Automatic, "PDF",
ColorFunction -> "DarkBands",
BaseStyle -> {FontSize -> 34, FontFamily -> "Arial"},
FrameStyle -> Directive[Black, AbsoluteThickness[3]],
ImageSize -> 800,
AspectRatio -> 0.5,
PlotRange -> All,
MeshStyle -> Black,
Mesh -> 0],
ContourPlot[PDF[d, {x, y}], {x, -4, 4}, {y, -5, 5},
PlotRange -> All,
Contours ->
Function[{min, max},
Rescale[{0.2, 0.4, 0.6, 0.8}, {0, 1}, {min, max}]],
ContourShading -> None,
ContourStyle -> {{Black, AbsoluteThickness[3]}}]]
回答
3 JimB Oct 22 2020 at 05:21
コメント内の2つのリンクを組み合わせると、次のことが実行できます。
(* Generate some data *)
SeedRandom[12345];
somePoints = RandomVariate[BinormalDistribution[{-2, 2}, {1, 1}, 0.8], 1000];
(* Construct smooth kernel distribution *)
d = SmoothKernelDistribution[somePoints];
(* Find the pdf values on a fine grid and sort by value of pdf *)
pdf = Reverse[Sort[Flatten[Table[PDF[d, {x, y}], {x, -7, 3, 0.05}, {y, -3, 6, 0.05}]]]];
(* Obtain cdf of those values *)
cdf = Accumulate[pdf]/Total[pdf];
(* Give labels for probabilities of interest *)
probabilities = {"0.2", "0.4", "0.6", "0.8"};
(* Determine contours associated with each probability *)
contours = pdf[[Flatten[Table[FirstPosition[cdf, p_ /; p >= alpha], {alpha, ToExpression[probabilities]}]]]];
(* Construct link between the contours and the probability labels along with the desired style of text *)
link = AssociationThread[contours -> probabilities];
f = Text[Style[link[#3], 15, Bold, Red], {#1, #2}] &;
(* Plot results *)
Show[SmoothDensityHistogram[somePoints, Automatic, "PDF", ColorFunction -> "DarkBands",
BaseStyle -> {FontSize -> 34, FontFamily -> "Arial"},
FrameStyle -> Directive[Black, AbsoluteThickness[3]], ImageSize -> 800,
AspectRatio -> 0.5, PlotRange -> All, MeshStyle -> Black, Mesh -> 0],
ContourPlot[PDF[d, {x, y}], {x, -7, 3}, {y, -3, 6}, PlotRange -> All,
Contours -> contours, ContourLabels -> f, ContourShading -> None,
ContourStyle -> {{Black, AbsoluteThickness[3]}}]]