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>

```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,
>      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

```

• Prev by Date: Re: Number of interval Intersections for a large number of
• Next by Date: Re: Install problem, 6.0, Mac OS 10.4.10: No kernel connect?
• Previous by thread: Re: Re: Equivalent functionality to colorbar in Mathematica?
• Next by thread: Controlling the display speed of exported Animate or Manipulate