1
$\begingroup$

I want to make a RegionPlot (or possibly a ContourPlot) in $x$-$y$ space that indicates which among a set of functions is the biggest value for a given $(x, y)$.

Suppose I have (in this example) three functions assembled in a list:

f[x_, y_] = Sin[x*y]
g[x_, y_] = Cos[x*y/2]
h[x_, y_] = Sin[x*y^2/7 + 2 \[Pi]/E]
(*and possibly more...*)

list[x_, y_] = {f[x,y], g[x,y], h[x,y]}

and I want to paint a region blue if f[x] is largest in that region, magenta if g[x] is largest and dark yellow if h[x] is largest. The end result would be collage of colors corresponding to largest among the functions.

Is there a way using functional coding to do this? I'm looking for fastest fastest possible computing speed.

Any hints on possibly helpful Mathematica functions would be welcome.

Improve this question
$\endgroup$
0
1
$\begingroup$

Here's one way to construct the inequalities (see also Plot the plane so different condition has a different color):

fns = {Sin[x*y], Cos[x*y/2], Sin[x*y^2/7 + 2 \[Pi]/E]};
colors = {Blue, Magenta, Darker@Yellow};
rgns = Table[And @@ Thread[fns[[i]] >= Drop[fns, {i}]], {i, Length[fns]}];

Show[MapThread[
  RegionPlot[#1, {x, -2, 2}, {y, -2, 2}, ##2] &,
   {rgns, Thread[PlotStyle -> colors]}], 
  PlotRange -> All]

Mathematica graphics

There are some small gaps. They may be removed in this case with PlotPoints -> 60.

Addition

Even though on further consideration, it seems to me that this question is a duplicate of the one I linked to above, I'll add this, because it's fast and uses a small amount of memory. Increase PlotPoints for smoother contours.

plot = ParametricPlot[{x, y}, {x, -2, 2}, {y, -2, 2}, 
   MeshFunctions -> meshfns, Mesh -> {{0}}, Axes -> False];
With[{pts = First@Cases[plot, GraphicsComplex[p_, __] :> p, Infinity]},
 plot /. GraphicsComplex[p_, g_, opts___] :> GraphicsComplex[p,
    Last@Reap[
      plot /. 
       poly : Polygon[pp_] :> {
         Sow[#, First @ Position[Through[meshfns @@ Mean[pts~Part~#]], _?Positive]] & /@ 
          pp},
      Range@Length@colors,
      {colors[[#1]], Polygon[#2]} &
      ],
    opts]
 ]

Mathematica graphics

Improve this answer
$\endgroup$
2
  • $\begingroup$ Isn't this question an almost exact duplicate of the one you linked to? $\endgroup$
    – user484
    Aug 4 '14 at 20:43
  • $\begingroup$ @RahulNarain The region functions (from my answer) do not work on this region. So my initial reaction was that there was a difference. But kguler's solution would work here, if Min were replaced with Max. (I didn't consider it until you asked.) $\endgroup$
    – Michael E2
    Aug 4 '14 at 21:41

Not the answer you're looking for? Browse other questions tagged or ask your own question.