Re: Equivalent functionality to colorbar in Mathematica?
Mike Croucher
The following two commands produce a nice looking plot (in my opinion
anyway)
data=Table[Exp[-(x^2+y^2)],{x,-3,3,0.1},{y,-3,3,0.1}];
ListPlot3D[data,PlotRange->All,Boxed->False,Axes->False,ColorFunction->"TemperatureMap",Mesh->False]
The colour of the plot is related to the value of the data via the
TemperatureMap colour function but how do I include this information in a
legend on the plot? Ideally I would like to create something similar to the
legends shown in the following links
http://www.walkingrandomly.com/images/random/colorbar.gif
http://www.walkingrandomly.com/images/random/colorbar2.gif
Does anyone know of a simple way of doing this in Mathematica?
Thanks in advance,
Mike
Jens-Peer Kuska
try the
Needs["PlotLegends`"]
but the legend package is the same mess as in version 5.x
Regards
Jens
David Park
data = Table[Exp[-(x^2 + y^2)], {x, -3, 3, 0.1}, {y, -3, 3, 0.1}];
Row[{ListPlot3D[data,
PlotRange -> All,
Boxed -> False, Axes -> False,
ColorFunction -> "TemperatureMap",
Mesh -> False,
ImageSize -> 350],
ContourPlot[y, {x, 0, .1}, {y, 0, 1},
ColorFunction -> "TemperatureMap",
AspectRatio -> Automatic,
PlotRange -> {{0, 0.1}, {0, 1}},
PlotRangePadding -> 0,
FrameTicks -> {{Automatic, None}, {None, None}},
ImageSize -> 35]}, Spacer[5]]
--
David Park
djm...@comcast.net
http://home.comcast.net/~djmpark/
"Mike Croucher" <michael.p...@googlemail.com> wrote in message
news:fdt3a6$roe$1...@smc.vnet.net...
Will Robertson
wrote:
> The colour of the plot is related to the value of the data via the
> TemperatureMap colour function but how do I include this information in a
> legend on the plot?
Coincidentally, I just tried to find this out myself.
I'd also like to be able to draw these sorts of plots.
Will
DrMajorBob
David has even better examples in his DrawGraphics6 package.
Bobby
On Wed, 03 Oct 2007 01:32:28 -0500, David Park <djm...@comcast.net> wrote:
> Mike,
>
> data = Table[Exp[-(x^2 + y^2)], {x, -3, 3, 0.1}, {y, -3, 3, 0.1}];
>
> Row[{ListPlot3D[data,
> PlotRange -> All,
> Boxed -> False, Axes -> False,
> ColorFunction -> "TemperatureMap",
> Mesh -> False,
> ImageSize -> 350],
> ContourPlot[y, {x, 0, .1}, {y, 0, 1},
> ColorFunction -> "TemperatureMap",
> AspectRatio -> Automatic,
> PlotRange -> {{0, 0.1}, {0, 1}},
> PlotRangePadding -> 0,
> FrameTicks -> {{Automatic, None}, {None, None}},
> ImageSize -> 35]}, Spacer[5]]
>
>
--
Will Robertson
That's a nice way to do it, David. Much better than what I was looking
at :)
For my own conveniece I've wrapped my attempt (but with a 2D density
plot instead) into a function (appended below).
My main concern with the thing is extracting the min/max values of the
colorbar: my method currently uses Sow[] on the expression inside
DensityPlot with an EvaluationMonitor. This seems very wasteful (since
the expression is being evaluated twice for each data point, right?)
-- is there a better way?
Many thanks,
Will
Options[ColorbarPlot] = {Colors -> "PigeonTones", CLabel -> "",
XLabel -> "", YLabel -> "", Title -> "", NContours -> 15,
Height -> 8*72/2.54};
ColorbarPlot[expr_, xr_, yr_, OptionsPattern[]] :=
Module[{contours},
rawPlot =
DensityPlot[expr, xr, yr,
EvaluationMonitor :> Sow[expr],
ImageSize -> {Automatic, OptionValue[Height]},
ColorFunction -> OptionValue[Colors],
FrameLabel -> {{OptionValue[YLabel], None}, {OptionValue[XLabel],
OptionValue[Title]}}] // Reap;
contours = rawPlot[[2, 1]];
Row[{rawPlot[[1]],
ContourPlot[
y, {x, 0, (Max[contours] - Min[contours])/
OptionValue[NContours]},
{y, Min[contours], Max[contours]},
Contours -> OptionValue[NContours],
ImageSize -> {Automatic, OptionValue[Height]},
ColorFunction -> OptionValue[Colors],
AspectRatio -> Automatic, PlotRange -> Full,
PlotRangePadding -> 0,
FrameLabel -> {{"", ""}, {"", OptionValue[CLabel]}},
FrameTicks -> {{All, None}, {{{0, ""}}, None}}]}]
]
ColorbarPlot[x^2 + y^2, {x, -10, 10}, {y, -10, 10}, XLabel -> "x",
YLabel -> "y", Title -> "Title", CLabel -> "Range"]
michael.p...@googlemail.com
David - thanks for that it looks great and isn't too complicated.
Jens - I agree with you, the PlotLegends package is not very nice at
all.
Regards,
Mike
On 3 Oct, 07:46, "David Park" <djmp...@comcast.net> wrote:
> Mike,
>
> data = Table[Exp[-(x^2 + y^2)], {x, -3, 3, 0.1}, {y, -3, 3, 0.1}];
>
> Row[{ListPlot3D[data,
> PlotRange -> All,
> Boxed -> False, Axes -> False,
> ColorFunction -> "TemperatureMap",
> Mesh -> False,
> ImageSize -> 350],
> ContourPlot[y, {x, 0, .1}, {y, 0, 1},
> ColorFunction -> "TemperatureMap",
> AspectRatio -> Automatic,
> PlotRange -> {{0, 0.1}, {0, 1}},
> PlotRangePadding -> 0,
> FrameTicks -> {{Automatic, None}, {None, None}},
> ImageSize -> 35]}, Spacer[5]]
>
> --
> David Park
> djmp...@comcast.nethttp://home.comcast.net/~djmpark/
>
> "Mike Croucher" <michael.p.crouc...@googlemail.com> wrote in message
>
> news:fdt3a6$roe$1...@smc.vnet.net...
>
DrMajorBob
the function syntax a bit.
ClearAll[ColorbarPlot]
Options[ColorbarPlot] = {Colors -> "PigeonTones", CLabel -> "",
XLabel -> "", YLabel -> "", Title -> "", NContours -> 15,
Height -> 8*72/2.54};
ColorbarPlot[function_, {___, x1_, x2_}, {___, y1_, y2_},
OptionsPattern[]] :=
Module[{contours, monitor, max = -Infinity, min = Infinity},
monitor[x_?NumericQ, y_?NumericQ] :=
Module[{val = function[x, y]}, min = Min[min, val];
max = Max[max, val]; val];
Row[{DensityPlot[monitor[x, y], {x, x1, x2}, {y, y1, y2},
ImageSize -> {Automatic, OptionValue[Height]},
ColorFunction -> OptionValue[Colors],
FrameLabel -> {{OptionValue[YLabel], None}, {OptionValue[XLabel],
OptionValue[Title]}}],
ContourPlot[
y, {x, 0, (max - min)/OptionValue[NContours]}, {y, min, max},
Contours -> OptionValue[NContours],
ImageSize -> {Automatic, OptionValue[Height]},
ColorFunction -> OptionValue[Colors], AspectRatio -> Automatic,
PlotRange -> Full, PlotRangePadding -> 0,
FrameLabel -> {{"", ""}, {"", OptionValue[CLabel]}},
FrameTicks -> {{All, None}, {{{0, ""}}, None}}]}]]
Clear[f]
f[x_, y_] := x^2 + y^2
ColorbarPlot[f, {-10, 10}, {-10, 10}, XLabel -> "x", YLabel -> "y",
Title -> "Title", CLabel -> "Range"]
or
ColorbarPlot[f, {x, -10, 10}, {y, -10, 10}, XLabel -> "x",
YLabel -> "y", Title -> "Title", CLabel -> "Range"]
I'm sure there's a better, more direct way via retrieving values from the
DensityPlot. I'll let you know if I find it.
Bobby
On Wed, 03 Oct 2007 05:33:46 -0500, Will Robertson <wsp...@gmail.com>
wrote:
> Row[{rawPlot[[1]],
> ContourPlot[
> y, {x, 0, (Max[contours] - Min[contours])/
> OptionValue[NContours]},
> {y, Min[contours], Max[contours]},
> Contours -> OptionValue[NContours],
> ImageSize -> {Automatic, OptionValue[Height]},
> ColorFunction -> OptionValue[Colors],
> AspectRatio -> Automatic, PlotRange -> Full,
> PlotRangePadding -> 0,
> FrameLabel -> {{"", ""}, {"", OptionValue[CLabel]}},
> FrameTicks -> {{All, None}, {{{0, ""}}, None}}]}]
> ]
> ColorbarPlot[x^2 + y^2, {x, -10, 10}, {y, -10, 10}, XLabel -> "x",
> YLabel -> "y", Title -> "Title", CLabel -> "Range"]
>
>
>
--
DrMajorBob
direct mention of the maximum or minimum function value. There are no Real
numbers near the maximum, for instance, even in the Normal version of the
plot. Possibly the truth is intricately coded somewhere, but I'm beginning
to doubt it.
Will Robertson
> OK, I've satisfied myself that DensityPlot doesn't retain, within it, any
> direct mention of the maximum or minimum function value.
That's a shame. Oh well.
> I think this eliminates the double evaluations, at the cost of changing
> the function syntax a bit.
Great, that's better. I don't mind changing the syntax at all.
By the way, DensityPlot works a lot better than ContourPlot for the
colorbar :) that was my mistake as I'd started out with Contours
instead of gradients before realising (a) gradients look a bit nicer
for what I'm doing, and (b) contours are harder to label.
Is it usual practise to put little functions like this up in Wolfram's
Mathematica library