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