How can I label a ListDensityPlot with a color bar?

Question

Here is an example of what is desired, only the result wouldn't be a contour plot, but a ListDensityPlot. The arguments would be a gradient and a list of numbers.

Answer 1

Here is a transcription of my related answer to the problem at hand - hopefully I understand the question correctly:

Take an example data set:

t = Flatten[
   Table[{x, y, 2/((x - 1)^2 + y^2)}, {x, -5, 5, .3}, {y, -5, 5, .3}],
    1];

{plot, colors, range} = reportColorRange[ListDensityPlot[t]]

Use the function definitions I posted earlier, except that I replace colorLegend with this, which takes an additional argument n corresponding to the number of discrete divisions that you would like:

colorLegend[cFunc_, range_, n_, opts : OptionsPattern[]] := 
 Module[{frameticks}, 
  frameticks = {If[TrueQ["LeftLabel" /. {opts}], 
       Reverse[#], #] &@{None,
      Function[{min, max}, {#,

          trimPoint[#, ("Digits" /. {opts} /. 
             "Digits" -> 3)], {0, .1}} & /@ 
        Table[min + (i - 1) (max - min)/(n - 1), {i, n}]
       ]}, {None, None}};
  Framed[Graphics[Inset[Graphics[Raster[
       Transpose@{Map[List @@ ColorConvert[cFunc[#], RGBColor] &,
          (Range[n - 1] - 1)/(n - 2)]}], ImagePadding -> 0, 
      PlotRangePadding -> 0,
      AspectRatio -> Full], {0, First[range]}, {0, 0}, {1, 
      range[[-1]] - range[[1]]}],
    PlotRange -> {{0, 1}, range[[{1, -1}]]},
    Frame -> True, FrameTicks -> frameticks,
    LabelStyle -> (LabelStyle /. {opts} /. LabelStyle -> Black),
    PlotRangePadding -> 0, AspectRatio -> Full], 
   Background -> (Background /. {opts} /. Background -> LightGray), 
   FrameStyle -> (FrameStyle /. {opts} /. FrameStyle -> None), 
   RoundingRadius -> (RoundingRadius /. {opts} /. 
      RoundingRadius -> 10)]]

With this, the example plot is now

contour = 
 display[{plot // at[{0, 0}, .8], 
   colorLegend[colors, range, 5] // 
    at[{0.85, .1}, Scaled[{.15, .5}]]}, AspectRatio -> .85]

If this turns out to be close to what is desired, one could modify it further to allow a list of tick marks to be provided as an argument. Right now I only take the number of marks and divide the automatically determined plot color range equally.

Answer 2

Let's say this is your ListDensityPlot:

myPlot = ListDensityPlot[{{1, 1, 1, 1}, {1, 2, 1, 2}, {1, 1, 3, 
 1}, {1, 2, 1, 4}}, ColorFunction -> "LakeColors", Mesh -> All];

Here's a legend for it:

Needs["PlotLegends`"];
myLegend = 
Graphics[{Legend[ColorData["LakeColors"][1 - #1] &, 6, "", "",
   LegendShadow -> {0.025, -0.025}]}, Axes -> {True, True},
   Ticks -> {None, 
   Join[Table[{-.21 - (.13 k), 120 - 20 k, {0.75`, 0.`}, {GrayLevel[0.`], 
           AbsoluteThickness[0.25`]}}, {k, 0, 6}],
        Table[{-.21 - (.13/4 k),  "", {0.0375`, 0.`}, {GrayLevel[0.`], 
           AbsoluteThickness[0.25`]}}, {k, 0, 24}]]},ImagePadding->20]

Now put them together:

GraphicsRow[{myPlot, myLegend}

---

The underlying logic can be generalized into a function:

gradientLegend[max_, min_, levels_, subdivisions_, cs_: "LakeColors"] := 
  Graphics[{Legend[ColorData[cs][1 - #1] &, levels, "", "",
    LegendShadow -> {0.025, -0.025},ShadowBackground -> Gray]}, Axes -> {False, True},
    Ticks -> {None, Join[
           Table[{-.21 - (((-.21 + .99)/levels) k), max - ((max - min)/levels) k,  
           {0.75`, 0.`}, {GrayLevel[0.`], AbsoluteThickness[0.25`]}}, {k, 0, levels}],
           Table[{-.21 - (((-.21 + .99)/levels)/subdivisions  k), 
            "", {0.0375`, 0.`}, {GrayLevel[0.`],   
            AbsoluteThickness[0.25`]}}, {k, 0, subdivisions*levels}]]}, 
 ImagePadding -> 20]

max is the maximum value on the gradient; min is the minimum value; levels is the number of distinct colors in the legend; subdivisions refers to the number of minor ticks; cs refers to the color scheme;

Example:

gradientLegend[250, 90, 8, 5, "IslandColors"]

Answer 3

Using Grid results in relatively terse code, eg:

ageColorLegend = Style[#, Background -> GrayLevel[0.75]] &@
  (Labeled[#, "Age", Top] & @
     Grid @
      Table[age -> ColorData[{"TemperatureMap", {8, 21}}][age], {age, 
        8, 21, 1}] /. (age_ -> color_) :> { 
      Graphics[{color, PointSize[0.5], Point[{0, 0}]}, 
       ImageSize -> 20],
      Style[age, FontFamily -> "Helvetica"]
      }
   )

In general I find Row, Column and Grid enable building composite graphics that also use expressions.