9
$\begingroup$

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.

enter image description here

$\endgroup$
6
  • $\begingroup$ I presume the ShowLegend[] function is not up to your needs? $\endgroup$ Commented Jun 27, 2012 at 17:35
  • 1
    $\begingroup$ This looks like an application of the question "ShowLegend values" - my answer there should be applicable to this case. $\endgroup$
    – Jens
    Commented Jun 27, 2012 at 17:50
  • 1
    $\begingroup$ But the ListDensityPlot shows a continuum of values ... $\endgroup$ Commented Jun 27, 2012 at 17:53
  • $\begingroup$ @belisarius Thanks for clarifying this - I hope I'm getting the intention right in the answer I posted... $\endgroup$
    – Jens
    Commented Jun 27, 2012 at 18:12
  • $\begingroup$ @Jens you got it right :) My comment was for the OP $\endgroup$ Commented Jun 27, 2012 at 18:28

4 Answers 4

7
$\begingroup$

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]

bar discrete cols

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.

$\endgroup$
4
$\begingroup$

I know this is an old question, but just in case:

Now in Mathematica 9.0 or higher, PlotLegends does this automatically.

ListDensityPlot[ Table[Sin[j^2 + i], {i, 0, Pi, 0.02}, {j, 0, Pi, 0.02}], 
 PlotLegends -> Automatic]

enter image description here

Cite: Documentation

$\endgroup$
3
$\begingroup$

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}

ListPlotDensity


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

legend 2

$\endgroup$
1
  • $\begingroup$ Warning. I haven't tested the above code under widely varying numbers of color levels. For that matter, I've put it through almost no pounding. $\endgroup$
    – DavidC
    Commented Jun 27, 2012 at 20:35
0
$\begingroup$

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.

$\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.