Services & ResourcesWolfram ForumsMathGroup Archive

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

Re: 2D-Plot Colorings

• To: mathgroup at smc.vnet.net
• Subject: [mg54260] Re: 2D-Plot Colorings
• From: "Wolf, Hartmut" <Hartmut.Wolf at t-systems.com>
• Date: Mon, 14 Feb 2005 21:50:57 -0500 (EST)
• Sender: owner-wri-mathgroup at wolfram.com

>-----Original Message-----
>From: Bruce Colletti [mailto:vze269bv at verizon.net] 
To: mathgroup at smc.vnet.net
>Sent: Monday, February 14, 2005 4:17 AM
>To: mathgroup at smc.vnet.net
>Subject: [mg54260]  2D-Plot Colorings
>
>Re Mathematica 5.1.
>
>In plotting y = x^2 over [-1,1], I want to color red those 
>points whose y-values are in [0.2, 0.4].  All others are blue.
>
>Although I can do this by manipulating the FullGraphics object 
>or by displaying separate plots, is there an easier way via 
>some Plot option?  ColorFunction doesn't seem to work 
>(probably user error), and neither does the Plot3D convention 
>in which shading is co-declared with the function.
>
>Thankx.
>
>Bruce
>
>

Bruce,

there is no PlotOption for this -- I think -- so it seems to be ok to
manipulate the graphics object produced.  This has several advantages:
no extra evaluations of the functions are needed, no inverse function is
needed, and all complications of numerical function inversion to get at
disjoint plot ranges for the independ variable x are avoided.

If we manipulate the graphics line, we assign each point of the line to
a color region according to its y-value, but we must generate an extra
point (by linear interpolation) where the line crosses the border
between two color regions. It may even be the case that a line segment
crosses more than one border; then multiple points have to be generated
for intermediate segments.


Here is a function that does this (for one line, but generalisation
should be straightforward):


regionPlot[expr_, range_, thresholds_List, colors_List, opts___] :=
  Module[{g1, x, y, regionColor, markRegion, regionBorder, ss, pp, rr,
jj, ll,
       oldline, newlines},

    g1 = Plot[expr, range, DisplayFunction -> Identity, opts];
    oldline = g1[[1, -1, 1, 1]];

    MapThread[(regionColor[#1] = #2) &, {Range[Length[thresholds] + 1], 
        PadRight[colors, Length[thresholds] + 1, colors]}];

    markRegion[{x_, y_}] = 
      Which @@ Join @@ 
          Transpose[{Append[ Thread[y < thresholds], True], {#, x, y} &
/@ 
                Range[Length[thresholds] + 1]}];

    MapThread[(Evaluate[regionBorder @@ #1] = #2) &, {Partition[
          Range[Length[thresholds] + 1], 2, 1], thresholds}];

    regionBorder[x_, y_] := regionBorder[y, x];
    regionBorder[_, _] := Undefined;

    ss = Split[markRegion /@ oldline, First[#1] === First[#2] &];

    pp = Drop[
        Partition[RotateLeft [Join @@ (Through[{First, Last}[#]] &) /@
ss], 
          2], -1];

    rr = Join @@ 
            Function[seg, 
                Distribute[Prepend[p Rest[#1] + (1 - p)Rest[#2], seg], 
                    List] /. 
                  Solve[{p Last[#1] + (1 - p)Last[#2] == regionBorder @@
seg},
                       p][[1]]] /@ 
              Partition[
                Range[First[#1], First[#2], Sign[First[#2] -
First[#1]]], 2, 
                1] & @@@ pp;

    jj = Join @@ Drop[Join @@ Transpose[{ss, Append[rr, Null]}], -1];

    ll = Split[jj, First[#1] === First[#2] &];

    newlines = {regionColor[#[[1, 1]]], 
            Line[Rest /@ #]} & /@ ll;

    Show[Graphics[newlines], DisplayFunction -> $DisplayFunction, 
      g1[[2]]]
    ]


First we define some little helpers:

markRegion marks each point with a number (for the region);
regionColor assigns to each region ist corresponding color;
regionBorder returns the y-threshold of two adjacent regions.

Now we mark each point with its region and split the line into regions
--> ss

Then we find the segments between regions, these have to be cut into two
(or more) --> pp

We interpolate these segments and assign the proper region to the new
segments --> rr

These new segments have to be spliced into the already existing ones at
there proper places --> jj

Then split again into lines for regions and converted to graphics
objects with their right colors -> ll, newlines

Finally displayed.



(Another obvious generalisation wound be to have non-constant thresholds
for regions.)




You may try e.g.:


regionPlot[x^2, {x, -1, 1}, {0.2, 0.4}, {Hue[2/3], Hue[0]}]

regionPlot[
  Sin[x], {x, 0, 9 Pi}, {-.8, -0.2, 0.2, 0.8}, {Hue[1/6], Hue[1/2],
Hue[2/3], 
    Hue[5/6]}]

regionPlot[
  BesselJ[5, x], {x, 0, 20 Pi}, {-.2, -0.1, 0, 0.1, 0.2}, {Hue[0],
Hue[1/2]}]


--
Hartmut Wolf