Re: Re: Equivalent functionality to colorbar in Mathematica?
- To: mathgroup at smc.vnet.net
- Subject: [mg81828] Re: [mg81804] Re: Equivalent functionality to colorbar in Mathematica?
- From: DrMajorBob <drmajorbob at bigfoot.com>
- Date: Thu, 4 Oct 2007 04:27:53 -0400 (EDT)
- References: <200709300744.DAA20164@smc.vnet.net> <fdt3a6$roe$1@smc.vnet.net> <6810751.1191429101231.JavaMail.root@m35>
- Reply-to: drmajorbob at bigfoot.com
I think this eliminates the double evaluations, at the cost of changing
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 <wspr81 at gmail.com>
wrote:
> Hi,
>
> 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"]
>
>
>
--
DrMajorBob at bigfoot.com