The expression for q is not terribly ugly:
q[a_, b_] =
Max[x /. Solve[((48*a^2 + 16*b)*x^4 - (40*a^3 + 168*a*b)*x^3) +
(-45*a^4 + 225*a^2*b + 72*b^2)*
x^2 + (27*a^3*b - 162*a*b^2)*x + 27*b^3 == 0, x,
Reals]]
but it has a condition b - Root[375 a^8 - 3600 a^6 #1 + 8088 a^4 #1^2 - 6912 a^2 #1^3 +
2048 #1^4 &, 1] < 0
, which does not seem to be compatible with your b=1.08148a^2+?:
Show[RegionPlot[
b - Root[375 a^8 - 3600 a^6 #1 + 8088 a^4 #1^2 - 6912 a^2 #1^3 +
2048 #1^4 &, 1] < 0, {a, -2, 2}, {b, -2, 2}],
Plot[1.08148 a^2, {a, -2, 2}]]
unless I misunderstood or made a mistake.