Even with Evaluate[], Mathematica is plotting everything in the same color

Question

The code

evals[x_?NumericQ] := Eigenvalues[{{x^2, 2 x}, {x, 3 x^2}}];
Plot[Evaluate[evals[x]], {x, -1, 1}]

gives both eigenvalues in the same color. I thought adding Evaluate[] was supposed to make them two different colors. I've tried the setting Evaluated->True but that doesn't help.

Changing the second line to

Plot[{evals[x][[1]], evals[x][[2]]}, {x, -1, 1}]

works, but I figure in this case Mathematica is evaluating the function evals[x] twice for each x. This is a toy example, and in my actual application the function corresponding to evals[] is extremely complicated and takes Mathematica quite a while to compute (which is why I have the ?NumericQ pattern test in the argument of evals), so I'd really prefer to have Mathematica only have to call evals[] once for each x, but still plot the two results in different colors.

Answer 1

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

Answer 2

To make Plot aware that it's a list:

evals[x_] = Eigenvalues[{{x^2, 2 x}, {x, 3 x^2}}]
Plot[Evaluate@evals@x, {x, -1, 1}, PlotStyle -> {Red, Green}]