Complicated symbolic coefficient slows down equation solving

Question

Here's a simple example for Solve:

test[f_] :=
 ListPlot[Table[{n, 
    First@AbsoluteTiming@With[{c = Nest[f, c, n]}, Solve[c x^2 + x + 1 == 0, x]]}, 
       {n, 0, 100, 5}], Filling -> Axis, PlotRange -> All]

test[Sqrt[c + #] &]

For any value of n, Solve is essentially dealing with the same equation, but the timing increases signifiantly as the coefficient c becomes more compilcated. Similar behavior can be observed in the tests for DSolve and RSolve. (I believe there're more.)

This truth astonishes me, because I thought Mathematica is clever enough to handle this sort of thing so I decide to write this post for complaining. To make this post a question, I want to ask:

1. Why Mathematica is cheated by the complicated coefficient?

2. Is there any general method to circumvent the issue? In my simple example, we just need to replace to only complicated coefficient with a simple one, but the coefficient to be replaced is not always obvious.

Answer 1

I don't know why Mathematica is slowed down by complicated constant, maybe there's a simple way to avoid it, but until someone finds this simple way you could use my ConstantsGrouping` package.

It provides GroupConstants function that can replace combinations of arbitrary complicated constant expressions with auto-generated "simple" constants. It returns pair containing "simplified" expression and Association of new constants to old constants combinations:

eq = Nest[Sqrt[c + #] &, c, 5] x^2 + x + 1 == 0
GroupConstants[eq, x]
(* 1 + x + Sqrt[c + Sqrt[c + Sqrt[c + Sqrt[Sqrt[2] Sqrt[c] + c]]]] x^2 == 0 *)
(* {
       1 + x + x^2 C[1] == 0,
       <|C[1] -> Sqrt[c + Sqrt[c + Sqrt[c + Sqrt[Sqrt[2] Sqrt[c] + c]]]]|>
} *)

One can solve "simplified" equation, then replace "simple" constants with original combinations of constants to get the same result as solving original equation:

Solve[eq, x] ===
    With[{eqConstsPair = GroupConstants[eq, x]},
        Solve[First@eqConstsPair, x] /. Last@eqConstsPair
    ]
(* True *)

Solve timings with and without GroupConstants:

ListPlot[
    With[{f = Sqrt[c + #] &},
        Table[
            {
                n, 
                With[{c = Nest[f, c, n]}, 
                    First@AbsoluteTiming@Solve[c x^2 + x + 1 == 0, x]
                ]
            },
            {n, 0, 100, 5}]
    ],
    Filling -> Axis, PlotRange -> All
]

ListPlot[
    With[{f = Sqrt[c + #] &}, 
        Table[
            {
                n,
                With[{c = Nest[f, c, n]},
                    First@AbsoluteTiming@With[
                        {eqConstsPair = GroupConstants[c x^2 + x + 1 == 0, x]},
                        Solve[First@eqConstsPair, x] /. Last@eqConstsPair
                    ]
                ]
            },
            {n, 0, 100, 5}
        ]
    ],
    Filling -> Axis, PlotRange -> All
]