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]

rugreplacement

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]

rug2

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]

Mathematica graphics


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]]]

enter image description here

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"]

enter image description here

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]]]

enter image description here

UnivariateDataRug

Statistics`DataDistributionUtilities`UnivariateDataRug[dt[[All, 1]]]

enter image description here

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]}}]

enter image description here