Services & Resources / Wolfram Forums / MathGroup Archive
-----

MathGroup Archive 2007

[Date Index] [Thread Index] [Author Index]

Search the Archive

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


  • 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