3
$\begingroup$

I am trying to draw a particular maximum plot within a simplex. I have functions based on two variables:

Write p,q for the two variables where p,q \geq 0 and p + q \leq 1. This defines the simplex I am interested in. (Think of, say, p on the x-axis and q on the y-axis.)

The functions are then of the following form:

f(p,q) = 22.5p + 10(1-p)

g(p,q) = 40(1-p-q) + 15(p+q)

h(p,q) = 10(1-q) + 22.5q.

(I am giving examples of functions---there are several I want to look at.)

I am interested in which function is "highest" for any given (p,q). So, for any given (p,q) in the simplex, I want to look at the max {f, g, h}. (The functions are such that almost always the maximum will be unique.) I then want it plot the point (p,q) as, say, red if f is the maximum function, blue if g is the maximum function, and green if h is the maximum function.

Does anyone have any idea how this can be done within mathematica?

Improve this question
$\endgroup$

2 Answers 2

Reset to default
4
$\begingroup$

Piggybacking on @kglr's answer, but using a right triangle rather than equilateral, so we can see p and q on the axes and to highlight the symmetry between f and h.

How about:

Plot3D[max[p, q], {p, q} \[Element] Triangle[{{0, 0}, {1, 0}, {0, 1}}],
  ColorFunction ->
  (Which[#3 == f[#1, #2], Red, #3 == g[#1, #2], Green, #3 == h[#1, #2], Blue] &),
  ColorFunctionScaling -> False, PlotPoints -> 100]

Mathematica graphics

A dirty trick to get a 2D plot is to move the ViewPoint to {0, 0, \[Infinity]}:

Plot3D[max[p, q], {p, q} \[Element] 
  Triangle[{{0, 0}, {1, 0}, {0, 1}}], 
 ColorFunction -> (Which[#3 == f[#1, #2], Red, #3 == g[#1, #2], 
     Green, #3 == h[#1, #2], Blue] &), ColorFunctionScaling -> False, 
 PlotPoints -> 100, ViewPoint -> {0, 0, \[Infinity]}, 
 Axes -> {True, True, False}, Mesh -> None]

Mathematica graphics

Here's another possible 2D solution:

DensityPlot[
  Which[
    max[p, q] == f[p, q], 1,
    max[p, q] == g[p, q], 2,
    max[p, q] == h[p, q], 3
  ],
 {p, q} \[Element] Triangle[{{0, 0}, {1, 0}, {0, 1}}], 
 PlotPoints -> 100, 
 ColorFunction -> (Which[#1 == 1, Red, #1 == 2, Green, #1 == 3, Blue] &),
 ColorFunctionScaling -> False
]

(similar output)

Of course hard coding the number of functions is ugly; it'd be nice to have this accept an arbitrary number of functions to compare!

Improve this answer
$\endgroup$
5
  • $\begingroup$ These pictures are beautiful. But I was rather hoping for a 2-Dimensional version of this---with say p on the x-axis and q on the y-axis. Is there any way to project the 3D figure onto 2D? Or draw it originally as 2D? $\endgroup$
    – Amanda
    Jul 22, 2019 at 17:13
  • $\begingroup$ @kglr any ideas on making your solution 2D? $\endgroup$
    – Chris K
    Jul 22, 2019 at 18:06
  • $\begingroup$ @ChrisK, found something that works-- could be cleaner. $\endgroup$
    – kglr
    Jul 22, 2019 at 19:20
  • $\begingroup$ @kglr Yeah, too bad RegionPlot leaves a big hole in the middle by default. $\endgroup$
    – Chris K
    Jul 22, 2019 at 19:48
  • $\begingroup$ @kglr may I ask a follow up on the comments here? I'm working with a more complicated version of the question I asked earlier. For various reasons, I ended up using the answer below that uses RegionPlot. I've been struggling getting a big white hole in the middle. I then noticed the comment above on RegionPlot. Why does this hole arise with RegionPlot and why does the MWE below not suffer from that problem? (I must have changed the solution below in a way that inserted the hole.) $\endgroup$
    – Amanda
    Feb 5, 2020 at 5:49
4
$\begingroup$ 
ClearAll[f, g, h]

f[p_, q_] := 22.5 p + 10 (1 - p)
g[p_, q_] := 40 (1 - p - q) + 15 (p + q)
h[p_, q_] := 10 (1 - q) + 22.5 q

max[p_, q_] := Max[f[p, q], g[p, q], h[p, q]]


Plot3D[max[p, q], {p, q} ∈ SSSTriangle[1, 1, 1], 
  Filling -> Bottom, Exclusions -> None]

enter image description here

{rf, rg, rh} =  Quiet @
  Reduce[#[p, q] >= max[p, q] , {p, q} ∈ SSSTriangle[1, 1, 1]] & /@ {f, g, h};

RegionPlot[{rf, rg, rh}, {p, 0, 1}, {q, 0, 1}, PlotStyle -> {Red, Blue, Green}]

enter image description here

Improve this answer
$\endgroup$
3
  • $\begingroup$ Can I ask for help in understanding the code for future issues? I think rf defines the region of (p,q) where f is the maximum, etc. This is achieved with '{rf, rg, rh} = Quiet @ Reduce[#[p, q] >= max[p, q] , {p, q} ∈ SSSTriangle[1, 1, 1]] & /@ {f, g, h};' Can you please explain this line... I'm confused by the role of 'Quiet @ Reduce[#[p, q] >= max[p, q]' and '& /@ {f, g, h}' @kglr (I hope this is the right formatting for comments?) $\endgroup$
    – Amanda
    Jul 23, 2019 at 0:11
  • 1
    $\begingroup$ @Amanda, you are about rf (rg and rh). I used Quiet to suppress warning messages that Reduce gives (try it by removing Quiet @ to see what i mean). For the second part related to & , /@ .., see (1) Function (&) and (2) Map (/@) in the documentation center ... $\endgroup$
    – kglr
    Jul 23, 2019 at 0:37
  • 1
    $\begingroup$ ... The function Reduce[#[p, q] >= max[p, q] , {p, q} ∈ SSSTriangle[1, 1, 1]] & a pure function (a function with unnamed argument(s))) (where Slot (#) is a placeholder for the argument.) We could have defined the same function using myreduce[arg_]:=Reduce[arg[p, q] >= max[p, q] , {p, q} ∈ SSSTriangle[1, 1, 1]]. When supplied an argument (myreduce[func] for example) this function gives the result of Reduce[func[p, q] >= max[p, q] , {p, q} ∈ SSSTriangle[1, 1, 1]]. $\endgroup$
    – kglr
    Jul 23, 2019 at 0:42

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

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