Let's assume you really can only evaluate your function evals
for numeric values. Then the approach of using Evaluate
or removing ?NumericQ
is not helping. For this situation, I see two possible solutions from the top of my head.
Using memoization suppress recalculation
evals[x_?NumericQ] := evals[x] = Eigenvalues[{{x^2, 2 x}, {x, 3 x^2}}];
Plot[{evals[x][[1]], evals[x][[2]]}, {x, -1, 1}]

With this, although it seems you call evals[x]
two times inside Plot
, it is actually only calculated once and for evals[x][[2]]
you access the value again.
If you haven't heard of memoization, start reading here and check out the links here.
Changing the colors of the plot afterwards
This is very simple too. You just plot evals[x]
, getting the one-colored plot. Then, you give every Line
primitive a different color. Here, I just create a variable colNum
which is increased after each replacement. The standard color scheme should be ColorData[97]
when I remember correctly:
gr = Plot[evals[x], {x, -1, 1}];
colNum = 1;
gr /. l_Line :> {ColorData[97, colNum++], l}

Apendix
Regarding your additional question
I agree that memoization would help if you have complete control over the arguments at which Mathematica evaluates the functions. But when you use Plot[]
or Plot3D[]
, does Mathematica do some kind of adaptive evaluation where (say) it evaluates the function more densely when it's changing more quickly? In this case, Mathematica wouldn't necessarily evaluate the function at the same places, so it would need to call the function twice as often.
Your understanding is completely correct. Although it will save evaluations, it usually won't cut the number of function calls in half when you call Plot
with automatic settings. The adaptive sampling you are talking about is the MaxRecursion
option of Plot
.
On the other hand, when you are setting MaxRecursion->0
and steer the sampling quality with the PlotPoints
options, the function will be sampled at exactly the same points. You can use the functionsReap
and Sow
to exactly check where and how often your definition is really evaluated if you like to investigate further.
Do you happen to know the primitive graphic element for Plot3D[]? I'm actually plotting using Plot3D to plot a function of two variables, although for the sake of clarity I simplified this in my OP.
I won't hold you accountable for that because you did a great job by pinning down the problem and presenting a simplified version of it here.
Let me show you how you could have inspected this yourself. First, you make as always a very simplified Plot3D
with two surfaces. Important is that you use very bad sampling settings, so that you don't have to deal with million of vertex points. In this specific case it means setting MaxRecursion
, PlotPoints
and removing all kind of meshes:
f[x_?NumericQ, y_?NumericQ] := {Sin[x + y^2], Cos[x^2 + y]};
gr3d = Plot3D[f[x, y], {x, -3, 3}, {y, -2, 2}, PlotPoints -> 3,
MaxRecursion -> 0, Mesh -> None]

Now you take a close look at InputForm[gr3d]
. What you can find out is that there is a longer style header that sets EdgeForm
, lighting and color. What follows then is a GraphicsGroup
consisting of two polygons.
When you compare this to a plot where you don't use f
but the real expression, you see that all the styling header and the GraphicsGroup
is done for each surface separately.
This is the base of your solution. Split the GraphicsGroup
of several polygons into a version where each polygon gets its separate styling header. If you only want to change the color (and not the lighting and all), then this can be simplified:
Either you create a new GraphicsGroup
with a leading color for each polygon
gr3d /. GraphicsGroup[polys:{_Polygon..}] :>
({RandomColor[],GraphicsGroup[{#}]}& /@ polys)
or you leave only one GraphicsGroup
and prepend a color to each polygon. With this, you have to make sure that you create a list {color, poly, color, poly, ...}
and not {{color, poly}, {color, poly}, ...}
because GraphicsGroup
expects a flat list of graphic primitives. I have enforced this by using Flatten
:
gr3d /. GraphicsGroup[polys : {_Polygon ..}] :>
GraphicsGroup[Flatten[{RandomColor[], #} & /@ polys]]
Both solutions result in something like this
