# Controlling point size and color in two list plots rendered by Show

Is there a good way to control both the size of a point and its color in a listplot? I am trying to create a 'projected band structure' plot, which involves putting points onto a graph and controlling their size, and ideally their color. I have been able to control the size using the method suggested in: Control PointSize on a ListPlot. This leads to random colors, which is not desired.

Photon = Sqrt[1 + x^2];
Exciton = 2;
Matrix = {{Photon, 0.15}, {0.15, Exciton}};
UpperBranch = Table[{x, Part[Eigenvalues[Matrix], 1]}, {x, 0, 3, 0.1}];
LowerBranch = Table[{x, Part[Eigenvalues[Matrix], 2]}, {x, 0, 3, 0.1}];
UpperBranchPhotonComponent =
Table[{x, (Part[Normalize[Part[Eigenvectors[Matrix], 1]], 1])^2}, {x, 0, 3, 0.1}];
UpperBranchExcitonComponent =
Table[{x, (Part[Normalize[Part[Eigenvectors[Matrix], 1]], 2])^2}, {x, 0, 3, 0.1}];
LowerBranchPhotonComponent =
Table[{x, (Part[Normalize[Part[Eigenvectors[Matrix], 2]], 1])^2}, {x, 0, 3, 0.1}];
LowerBranchExcitonComponent =
Table[{x, (Part[Normalize[Part[Eigenvectors[Matrix], 2]], 2])^2}, {x, 0, 3, 0.1}];

Show[
Plot[Eigenvalues[Matrix], {x, 0, 3},
PlotStyle -> {Thin, Black},
PlotTheme -> "Scientific"],
ListPlot[List /@ UpperBranch,
GridLinesStyle -> Black,
ImageSize -> 500,
PlotStyle -> PointSize /@ (Abs[Last /@ UpperBranchPhotonComponent]/75),
PlotMarkers -> None,
PlotTheme -> "Scientific"],
ListPlot[List /@ LowerBranch,
GridLinesStyle -> Black,
ImageSize -> 500,
PlotStyle -> PointSize /@ (Abs[Last /@ LowerBranchPhotonComponent]/75),
PlotMarkers -> None,
PlotTheme -> "Scientific"],
PlotRange -> All]


The result is shown below; Everything is working basically correctly, but I would like to have all the points be a single color, and this is proving to be difficult. Is there a simpler way to do this altogether, and especially a way to allow the color to be specified?

I believe the easiest way to take control of the elements you want to control is to specify them as graphics primitives in an Epilog option of the Eigenvalues plot.

Plot[Eigenvalues[Matrix], {x, 0, 3},
Epilog ->
{Red, 