3
$\begingroup$

My apologies if something similar has been asked, I could not find a question on the same issue. I have created the following colour map (heat map) using a toy sample with RandomReal.

s = RandomReal[{-1, 1}, {80, 50}];

ListDensityPlot[s, Mesh -> Automatic, Mesh -> All, 
  ColorFunction -> "Rainbow", FrameLabel -> {Number, Year}, 
  FrameTicks -> {{{{0, "Y1"}, {20, "Y2"}, {40, "Y3"}, {60, "Y4"}, {80,
        "Y5"}}, 
     None}, {{{1, "One"}, {10, "Two"}, {20, "Three"}, {30, 
       "Four"}, {40, "Five"}, {50, "Six"}}, None}}, 
  PlotLabel -> "Heat Map", PlotLegends -> Automatic, 
  PlotRange -> {-1, 1}] /. 
 x : (FrameTicks -> _) :> (x /. s_String :> Rotate[s, 45 Degree])

However, I may have missing observations on the map. If I fill the gaps with 0,they will appear green. If they are left balnk, the spaces will look white. Is it possible to set all values equal to 0 being coloured with something that is not in the palette (legend), e.g. black or grey?

The issue is one of presentation, since with my actual data a part of the map is missing and I would like to see if it having white or a different colour would make it look better.

On a side note, if you have a better colour palette or idea on how to visualise more-or-less random looking data, please be my guest.

$\endgroup$
1
  • $\begingroup$ What are the gaps You are mentioning? Data array is full of numbers which none of are 0 $\endgroup$
    – Lechuu
    May 18 at 15:04

2 Answers 2

3
$\begingroup$

A data set with missing observations:

SeedRandom[1];
s = Map[If[Abs[#] < 10^-1, Missing[], #] &, RandomReal[{-1, 1}, {80, 50}], {-1}];

Update:

In general, since non-numeric / missing data do not lie in the numeric range of plotted values, a more accurate legend would be a combination of BarLegend showing numerical values depicted in the plot and a seperate legend showing the color used for rendering non-numeric/missing values.

A simple way to achieve this is to combine a BarLegend with a SwatchLegend showing the label and color used to render missing/non-numeric values:

ListDensityPlot[s, Mesh -> Automatic, PlotRange -> {-1, 1}, 
 ColorFunction -> "Rainbow", 
 PlotLegends -> Column[
   {BarLegend["Rainbow", Frame -> False, LegendMargins -> 0], 
    SwatchLegend[{White}, {"Missing[]"}, LegendMarkerSize -> 14]}]]

enter image description here

The custom legend barLegendWithMissingValues below adds a rectangle with desired color/label/size for missing values below a regular BarLegend:

ClearAll[barLegendWithMissingValues]

barLegendWithMissingValues[label_ : Automatic, color_ : Automatic,  
   size_ : 30, gap_ : 3, offset_ : 10] := 
 Module[{coord = First@Cases[ToBoxes@#, RasterBox[_, a_, ___] :> First@a, All]},
   With[{txt = {label /. Automatic -> "Missing[]" /. Style -> StyleBox, 
        Offset[{offset, 0}, coord {-1, 1} - {0, gap + size/2}], Left},
     clr = color /. Automatic -> LightGray,
     rct = {#, # {-1, 1} + {0, size}} &@(coord - {0, size + gap}),
     ef = EdgeForm[Directive[AbsoluteThickness[.5], RGBColor[.5, .5, .5]]]},
    RawBoxes @ Replace[ToBoxes @ #,
      {a___, r_RasterBox, b___} :> RuleCondition @
        {a, r, InsetBox @@ txt, clr, ef, RectangleBox @@ rct, b}, All]]] &

Examples:

Row[{barLegendWithMissingValues[] @ BarLegend["Rainbow"],
  barLegendWithMissingValues[Style["NaN", 12], Brown, 50, 5]@
     BarLegend["Rainbow", LabelStyle -> 14],
  barLegendWithMissingValues[Style["NaN", 12], Black, 40, 15]@
     BarLegend[{"TemperatureMap", {-5, 15}}, LabelStyle -> 14, 
       LegendMarkerSize -> {90, 300}]}, Spacer[30]]

enter image description here

ReplaceAll[b_BarLegend :> barLegendWithMissingValues[Automatic, White]@b]@
 ListDensityPlot[s, Mesh -> Automatic, PlotRange -> {-1, 1}, 
  ColorFunction -> "Rainbow", PlotLegends -> Automatic]

enter image description here

ReplaceAll[b_BarLegend :> barLegendWithMissingValues[] @ b] @
 ListDensityPlot[s, Mesh -> Automatic, PlotRange -> {-1, 1}, 
  ColorFunction -> "Rainbow", BoundaryStyle -> White, 
  Prolog -> {LightGray, Rectangle[Scaled[{0, 0}], Scaled[{1, 1}]]}, 
  PlotLegends -> Automatic]

enter image description here

Original answer:

ListDensityPlot excludes (renders as White) areas where data is non-real. So we need to modify the BarLegend to show the color used for excluded areas. This can be done using the (undocumented) option StyledContours (or "StyledContours") and adding the associated tick label using the (also undocumented) option Ticks ("Ticks" also works) in BarLegend:

ListDensityPlot[s, Mesh -> Automatic, PlotRange -> {-1, 1}, 
 ColorFunction -> "Rainbow", 
 PlotLegends -> BarLegend[Automatic, 
   StyledContours -> {{0, Directive[Thick, White]}}, 
   Ticks -> (Range[-1, 1, .5] /. 0. -> {0, Missing[]})]]

enter image description here

We can set the color of excluded areas using Prolog and use the same color for styled contours in BarLegend:

ListDensityPlot[s, Mesh -> Automatic, PlotRange -> {-1, 1}, 
 ColorFunction -> "Rainbow",
 BoundaryStyle -> White, 
 Prolog -> {LightGray, Rectangle[Scaled[{0, 0}], Scaled[{1, 1}]]}, 
 PlotLegends ->  BarLegend[Automatic, 
    "StyledContours" -> {{0, Directive[AbsoluteThickness[5], LightGray]}}, 
    "Ticks" -> (Range[-1, 1, .5] /. 0. -> {0, Missing[]})]]

enter image description here

$\endgroup$
1
  • $\begingroup$ Many thanks! I accepted this as answer since it does not include a custom function and did teach me something about undocumented options, which I can use in the future. $\endgroup$
    – Titus
    May 19 at 9:16
2
$\begingroup$
SeedRandom[1];
s = RandomReal[{-1, 1}, {80, 50}];
Clear[cf]
cf[x_] := Blend[ReplacePart[
    ColorData["Rainbow"][#] & /@ Range[0, 1, 1/30]
    , {{15}, {16}, {17}} -> White
    ]
   , x
   ];

ListDensityPlot[s
  , Mesh -> Automatic
  , ColorFunction -> cf
  , FrameLabel -> {Number, "Year"}, 
  FrameTicks -> {{{{0, "Y1"}, {20, "Y2"}, {40, "Y3"}, {60, "Y4"}, {80,
        "Y5"}}, 
     None}, {{{1, "One"}, {10, "Two"}, {20, "Three"}, {30, 
       "Four"}, {40, "Five"}, {50, "Six"}}, None}}, 
  PlotLabel -> "Heat Map"
  , PlotLegends -> Placed[BarLegend[Automatic], After]
  , PlotRange -> {-1, 1}] /. 
 x : (FrameTicks -> _) :> (x /. s_String :> Rotate[s, 45 Degree])

enter image description here


EDIT

It is difficult to visually verify results with random numbers, so the following example is included.

data = Flatten[#, 1] &@
  Table[{x, y, Sin[x] Sin[y]}, {x, 0, 2 \[Pi], 0.1}, {y, 0, 2 \[Pi], 
    0.1}]

GraphicsRow[
 ListDensityPlot[data, PlotRange -> All, ColorFunction -> #, 
    PlotLegends -> {BarLegend[Automatic, LegendMarkerSize -> 180]}
    , ColorFunctionScaling -> True
    ] & /@ {"Rainbow", cf}
 ]
$\endgroup$
1
  • $\begingroup$ Many thanks! That worked fine. $\endgroup$
    – Titus
    May 19 at 9:15

Your Answer

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

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