14
$\begingroup$

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

sample plot

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

Improve this question
$\endgroup$
1
  • $\begingroup$ Sorry I simply had no time to reply until now - but since you mentioned my heatMap function I posted a modified version of it that should hopefully do what you want - or at least the needed modifications can be made easily. $\endgroup$
    – Jens
    Jul 11, 2012 at 0:08

3 Answers 3

Reset to default
10
$\begingroup$

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

smearedsquare

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]

heatmapThin

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]

heatmapDensityPlot

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]

No Smearing

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

heatline

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

Improve this answer
$\endgroup$
5
  • $\begingroup$ Jens, would you edit the question to include (a link to) the best concise description of a "heat map" you can find? I'll profess my ignorance and say I didn't realize that was a specialized chart type. $\endgroup$
    – Mr.Wizard
    Jul 11, 2012 at 0:31
  • $\begingroup$ @Mr.Wizard The link in the question points to a pretty long post describing exactly what the term "heat map" is supposed to mean. So I would certainly not fault Frederic for neglecting to explain things. But I'll see if I can make a modest modification to clarify the concept. $\endgroup$
    – Jens
    Jul 11, 2012 at 1:06
  • $\begingroup$ I'm not faulting anyone but myself. $\endgroup$
    – Mr.Wizard
    Jul 11, 2012 at 1:07
  • $\begingroup$ @Jens The result you plotted in Edit 2 was what I meant with heat line, but also to have a look at the PDF from Edit 3 is interesting to evaluate my data visually. I used the SmoothHistogram function before, but it seems that Mathematica interpolates the PDF to the x-Axis. Just compare your version from Edit 2 to SmoothHistogram[data, .02] $\endgroup$
    – Frederik Ziebell
    Jul 11, 2012 at 7:43
  • $\begingroup$ @FrederikZiebell It'r true that SmoothHistogram is buggy - confirmed by Wolfram when I sent them the bug report in the post you linked originally. But in terms of comparison fo this example, are you sure you're not just seeing a different plot range? That is, try PlotRange -> All (MMA draws the axes not necessarily at zero)... $\endgroup$
    – Jens
    Jul 11, 2012 at 15:05
7
$\begingroup$

Something like this would also work

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

Example output

Improve this answer
$\endgroup$
5
$\begingroup$

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
]

Mathematica graphics

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
]

Mathematica graphics

Another interpretation:

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

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

Mathematica graphics

Improve this answer
$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.