One-dimensional heatmap

Question

I want to plot a heatmap of a set of real points of the interval [0,1] - i.e., to display their linear density in the sense of a smoothed histogram. The idea I have come up so far is to use the heatMap function introduced here:

heatMap[data_, opts : OptionsPattern[]] := Module[
{n, size, xRange, pr},
n = "Points" /. {opts} /. {"Points" -> 100};
pr = PlotRange /. {opts} /. {PlotRange :> 
    Map[{Min[#], Max[#]} &, Transpose[data]]};
xRange = -Subtract @@ pr[[1]];
size = Floor[
  n ("Radius" /. {opts} /. {"Radius" -> xRange/6})/xRange];
Graphics[{
  Inset[
   ArrayPlot[
    Rescale@GaussianFilter[
      ImageData@ColorNegate@ColorConvert[
         Rasterize[Graphics[Point[data],
           Background -> White,
           PlotRangePadding -> 0,
           ImagePadding -> 0,
           ImageMargins -> 0,
           PlotRange -> pr],
          "Image", ImageSize -> n], "GrayScale"],
      {3 size, size}, Padding -> 0],
    ColorFunction ->  
     (ColorFunction /. {opts} /. 
      {ColorFunction -> 
       ColorData["LakeColors"]
      }
     ),
    ImagePadding -> 0,
    PlotRangePadding -> 0, Frame -> False],
   pr[[All, 1]], {0, 0}, xRange]},
 PlotRange -> pr, Frame -> True, PlotRangePadding -> Scaled[.02]
 ]
]

and converting the one dimensional data to two dimensions:

data = RandomReal[{0, 1}, 100];
data = {#, 0} & /@ data;

heatMap[data, "Points" -> 300, "Radius" -> .01, PlotRange -> {{0, 1}, {0, .05}}]

How do I have to modify heatMap to draw rectangles instead of points that blur at the edges? Or perhaps is there a shorter and more elegant way to draw a "heatline"?

Answer 1

It seems like none of the answers I see up to now are actually producing heat maps. The difference between a heat map and a ListDensityPlot is important. In Mathematica vocabulary, the heat map is a SmoothDensityHistogram.

First of all, I tried to directly use the 'heatMap' function in my answer. I just tried it with the data in that post:

data = RandomReal[1, {100, 2}];

Show[heatMap[data, "Points" -> 300, "Radius" -> {10, .02}, 
  PlotRange -> {{0, 1}, {0, 1}}, 
  ColorFunction -> ColorData["Rainbow"]], Graphics[Point@data], 
 PlotRange -> {{0, 1}, {0, 1}}]

All I did is to specify a tuple {10, .02} for the "Radius" option. Its first entry is the radius in the vertical direction, and with a choice of 10 this smears all the data out over the entire vertical image range.

This shows it works without modifying the code. But of course I have to tweak the function in order to make it look more "one-dimensional":

heatMap[data_, opts : OptionsPattern[]] := 
 Module[{n, size, xRange, pr}, 
  n = "Points" /. {opts} /. {"Points" -> 100};
  pr = PlotRange /. {opts} /. {PlotRange :> 
      Map[{Min[#], Max[#]} &, Transpose[data]]};
  xRange = -Subtract @@ pr[[1]];
  size = Floor[
    n ("Radius" /. {opts} /. {"Radius" -> xRange/6})/xRange];
  Graphics[
   {Inset[
     ArrayPlot[
      Rescale@GaussianFilter[
        ImageData@ColorNegate@ColorConvert[
           Rasterize[
            Graphics[
             Point[data],
             Background -> White,
             PlotRangePadding -> 0,
             ImagePadding -> 0,
             ImageMargins -> 0,
             PlotRange -> pr
             ],
            "Image",
            ImageSize -> n
            ],
           "GrayScale"
           ],
        {3 size, size},
        Padding -> 0
        ],
      ColorFunction -> (ColorFunction /. {opts} /. {ColorFunction -> 
           ColorData["LakeColors"]}),
      ImagePadding -> 0,
      PlotRangePadding -> 0,
      Frame -> False
      ],
     pr[[All, 1]],
     {0, 0}, xRange]},
   PlotRange -> pr,
   Frame -> True,
   FrameTicks -> {Automatic, None}
   ]
  ]

So here I removed the PlotRangePadding and the FrameTicks on the left side, as well as the PlotRangePadding. I think that's all you need to change. Having collapsed the data onto a single axis, the vertical smearing for GaussianFilter needs to be only of order 1 (in relation to the horizontal axis) - so that's what I used. Then I set the PlotRange appropriately and get this:

data = RandomReal[{0, 1}, 100];
data = {#, 0} & /@ data;

heatMap[data, "Points" -> 300, "Radius" -> {1, .02}, 
 PlotRange -> {{0, 1}, {0, .04}}, PlotRangePadding -> 0, 
 FrameLabel -> None]

The meaning of the option "Points" (number of horizontal sampling points) is the same as described in the linked post.

Edit

As I mentioned, a heat map is also realizable using built-in smoothed histogram techniques. I think the easiest way to do that in the present case would be as follows:

DensityPlot[
 Evaluate@PDF[SmoothKernelDistribution[data, {1, .02}], {y, x}], {x, 
  0, 1}, {y, 0, .2}, AspectRatio -> Automatic, PlotPoints -> {200, 2},
  FrameTicks -> {Automatic, None}, PlotRangePadding -> None]

The unequal smearing is now achieved by specifying a tuple for the "bandwidth" parameter in SmoothKernelDistribution: in {1, .02}, the 1 is again chosen to be large compared to the plot range in the y direction (from 0 to .2) so that you get vertical bands. It's of also necessary to adjust the number of PlotPoints to be large enough in the horizontal direction so as to capture all the details of the distribution. The vertical number of PlotPoints (the second number in {200, 2}) can be set to the smallest possible value, 2.

Edit 2

Of course, we can also backtrack even further and go to the original data set you started with - which was purely one-dimensional. In that situation, you can simply do something like this:

data = RandomReal[1, 100];

DensityPlot[
 Evaluate[{PDF[SmoothKernelDistribution[data, .02], x], 0}], {x, 0, 
  1}, {y, 0, .04}, AspectRatio -> Automatic, PlotPoints -> {200, 2}, 
 FrameTicks -> {Automatic, None}, PlotRangePadding -> None]

This involves no need for smearing in the vertical direction because it calculates the density function one-dimensionally in the first place. The methods above have their justification too, when the data list does have two-dimensional points that you want to project onto a single axis.

Edit 3

I also see the question asks for a "heatline" - if I understand this as a line plot, one could get it very straightforwardly:

Plot[Evaluate@PDF[SmoothKernelDistribution[data, .02], x], {x, 0, 1}]

This is simply a plot of the one-dimensional probability density function for the data set, smoothed with bandwidth .02.

Answer 2

Something like this would also work

data = {RandomReal[{0, 1}, 100]};
ArrayPlot[data, Frame -> True, 
 ColorFunction -> ColorData["LakeColors"], 
 FrameTicks -> {None, Automatic}]

Answer 3

I'm not sure I understand the question, but perhaps simply this?

data = RandomReal[{0, 1}, 100];
data = {#, 0} & /@ data;

Graphics[
  Raster[data\[Transpose], ColorFunction -> "LakeColors"],
  Frame -> {True, False},
  PlotRangePadding -> 0.5
]

If this interpretation is correct I don't know what the purpose of {#, 0} & /@ data is. Perhaps it is extraneous, and you want:

data = RandomReal[{0, 1}, 100];

Graphics[
  Raster[{data}, ColorFunction -> "LakeColors"], 
  Frame -> {True, False},
  PlotRangePadding -> 0
]

Another interpretation:

data = RandomReal[{0, 1}, 100];
data = {#, 0} & /@ data;

ListDensityPlot[
  data\[Transpose],
  PlotRange -> {All, {1, 1.1}}, 
  Frame -> {True, False},
  AspectRatio -> 0.02
]