Add a rug representation to plot
Just to illustrate the point I made in the comment, let's take a data set where the points stack up vertically, and verify what it looks like if we visualize their density by means of a color gradient as in the question One-dimensional heatmap. You first have to copy the definition of heatMap
from the second code block in my answer, and then execute this:
iris = ExampleData[{"Statistics", "FisherIris"}][[All, 1 ;; 2]];
h = Show[heatMap[Map[{#, 0} &, iris[[All, 1]]],
"Points" -> 2 Length[iris], "Radius" -> {1, .01},
PlotRange -> {{4, 8}, {0, .1}}, PlotRangePadding -> 0,
FrameLabel -> None,
ColorFunction -> (ColorData["SiennaTones"][1 - #] &)],
Frame -> None, PlotRangePadding -> None, ImagePadding -> None,
AspectRatio -> Full];
ListPlot[iris, Prolog -> Inset[h, {4, 0}, {4, 0}, 4],
PlotRange -> {{4, 8}, {0, 4.5}}, Frame -> True]
This replacement rug is made with a color gradient (SiennaTones
) that indicates clustering of data points by darker shading. I didn't automate the choice of plot parameters yet, but it could be done if you think it's useful. The example shows that bandwidth is not a problem because I use a Gaussian filter where the radius can simply be chosen to be as small as needed to achieve the maximal resolution.
Edit
Here is another example, where the data are distributed more irregularly:
mtcars = Import["mtcars.csv"];
x = Drop[mtcars[[All, 7]], 1];
y = Drop[mtcars[[All, 2]], 1];
h2 = Show[
heatMap[Map[{#, 0} &, x], "Points" -> 10 Length[x],
"Radius" -> {1, .01}, PlotRange -> {{1.5, 4.5}, {0, .1}},
PlotRangePadding -> 0, FrameLabel -> None,
ColorFunction -> (ColorData["SiennaTones"][1 - #] &)],
Frame -> None, PlotRangePadding -> None, ImagePadding -> None,
AspectRatio -> Full];
ListPlot[Thread[List[x, y]],
Prolog -> Inset[h2, {1.5, 0}, {1.5, 0}, 3],
PlotRange -> {{1.5, 4.5}, {0, 40}}, Frame -> True]
Here, I had to use more sampling points (option "Points"
) because the data are more closely spaced in some places.
Let's generate some data to play with:
SeedRandom[5]
Round@RandomVariate[UniformDistribution[{0, 20}], 35];
data = {#, 50 - 3 # + RandomReal[{-10, 10}]} & /@ %;
ListPlot[data, PlotRange -> All]
Here is a function that calculates the size and position of the plot "piles" and constructs the plot explicitly from graphics primitives:
Clear[rugplot]
rugplot[data_] := Module[
{plotpoints, piles, listplot, plotrange, padding, ystart, yend},
plotpoints = {PointSize[0.015], Point[data]};
plotrange = {Min[#], Max[#]} & /@ Transpose[data];
ystart = plotrange[[2, 1]];
yend = (plotrange[[2, 2]] - plotrange[[2, 1]])/15 + ystart;
piles = {
Thickness[#2/400], CapForm["Butt"],
Line[{{#1, ystart}, {#1, yend}}]
} & @@@ Tally[data[[All, 1]]];
Graphics[
{plotpoints, piles},
PlotRange -> plotrange, PlotRangePadding -> None,
AspectRatio -> 0.8, Frame -> True, Axes -> False
]
]
We can try this out with the sample data generated above:
rugplot[data]
This is almost there, but it still needs some cosmetic adjustments to the final plot range to add some padding and more space for the bars at the bottom. Unfortunately I have to go now, so I won't be able to make the adjustments straight away, but hopefully this will help for now.
"DistributionAxes" -> "Lines"
You can use DensityHistogram
with suboption "DistributionAxes" -> "Lines"
and ListPlot
of the data as Epilog
:
SeedRandom[1]
dt = RandomReal[1, {50, 2}];
DensityHistogram[dt, Method -> {"DistributionAxes" -> "Lines"},
BaseStyle -> FaceForm[],
Epilog -> ListPlot[dt, PlotStyle -> {Red, PointSize[Large]}][[1]]]
Alternatively, with sufficiently many equal-sized bins or sufficiently small bin widths, we can use ChartElementFunction -> "Point"
in DensityHistogram
to get a ListPlot
of data without using Epilog
:
DensityHistogram[dt, {100, 100},
Method -> {"DistributionAxes" -> "Lines"}, ColorFunction -> (Red &),
ChartBaseStyle -> PointSize[Large], ChartElementFunction -> "Point"]
Another example:
dist1 = BinormalDistribution[{1, 1}, {1, 1}, 1/2];
dist2 = BinormalDistribution[{5, 5}, {1, 1}, -1/2]; dt2 =
RandomVariate[MixtureDistribution[{3, 2}, {dist1, dist2}], 300];
DensityHistogram[dt2, Method -> {"DistributionAxes" -> "Lines"},
BaseStyle -> FaceForm[],
Epilog -> ListPlot[dt2, PlotStyle -> {Red, PointSize[Large]}][[1]]]
UnivariateDataRug
Statistics`DataDistributionUtilities`UnivariateDataRug[dt[[All, 1]]]
With some processing (to remove arrows and to change orientation), the output of Statistics`DataDistributionUtilities`UnivariateDataRug
can be used to construct data rugs for the vertical and horizontal axes.
ClearAll[rugF]
rugF[dir : ("horizontal" | "vertical") : "horizontal"] :=
Module[{rule = If[dir === "horizontal",
Thread[{{x_, 0}, {x_, 1}} :> {{x, -.025}, {x, -.075}}],
Thread[{{x_, 0}, {x_, 1}} :> {{-.025, x}, {-.075, x}}]]},
Statistics`DataDistributionUtilities`UnivariateDataRug[#] /.
Arrow[x_] :> {CapForm["Butt"], Line[x]} /. rule ] &;
Show[ListPlot[dt, PlotStyle -> PointSize[Large]],
rugF["vertical"][dt[[All, 2]]], rugF[][dt[[All, 1]]],
AspectRatio -> 1, Frame -> True, AxesOrigin -> {0, 0},
PlotRangePadding -> {{.1, Scaled[.02]}, {.1, Scaled[.02]}}]