A problem with polynomial root finding

I use the expression

N[(x - Sqrt[2] + Sqrt[3]*I + 10^-20*(1 + I))^50*(x - Sqrt[2] +
Sqrt[3]*I)^25*(x - Sqrt[2] + Sqrt[3]*I +
2*10^-20*(1 + I))^13*(x - Sqrt[2] + Sqrt[3]*I +
3*10^-20*(1 + I))^12, 5000]


to gernerate a highly ill-conditioned polynomial. Then I use

N[Expand[%, x], 5000]


to expand it. Finally, I want to use

NSolve[%, x, 50]


to solve it. However. the kernel breaks down after running thirty minutes or so, without indicating that it is out of memory.

Is this a Mathematica bug? Are there any bugs in the Jenkins Traub method? Or are there bugs in Mathematica's precision control?

-
That's an awful lot of precision. Is it really necessary? – Mr.Wizard Aug 31 '13 at 6:14
Does one really need to do N[Expand[%, x], 5000] since the expression is already set as N[...., 5000] ?? Would not a simple Expand[%,x] work just the same? – Nasser Aug 31 '13 at 6:14
Wait, shouldn't first argument of NSolve be an equation or list of equations? – Mr.Wizard Aug 31 '13 at 6:17
If you use FindRoot, you'll have better luck: FindRoot[expr == 0, {x, 50}] gives {x -> 19.1982 - 1.09806 I} (but this ofcourse finds one root). But with a warning saying Failed to converge to the requested accuracy or precision within 100 iterations – Nasser Aug 31 '13 at 6:18
@Nasser Thanks, I tried all the versions from 5.0-9.0 on windows 7 x64 and it remains the crash. It is acceptable that the problem cannot be solved due to the algorithm itself, but the screen shot is not friendly and wolfram do not give any recommendation. Users may think if there are any dangerous factors in the functions that mathematica provided. Hope it can be reported as an issue. – Zhong Aug 31 '13 at 6:47

The crash is because you set WorkingPrecision too low.

Simply making WorkingPrecision higher solved the problem. (no crash) but notice that some roots print saying no significant digits available to display (pink boxes).

I found this when I increased the WorkingPrecision to 5000 from 50, and then saw the message NSolve::precw: The precision of the argument function....is less than WorkingPrecision (but no crash!, strange)

So, I just put it at Infinity, which is default, from looking at options:

Select[Flatten[
Trace[NSolve[expr == 0, x], TraceInternal -> True]], !
FreeQ[#, Method | NSolveMethodData] &]


expr = N[(x - Sqrt[2] + Sqrt[3] I + 10^-20 (1 + I))^50*(x - Sqrt[2] +
Sqrt[3] I)^25 (x - Sqrt[2] + Sqrt[3]*I +
2*10^-20*(1 + I))^13*(x - Sqrt[2] + Sqrt[3]*I +
3*10^-20*(1 + I))^12, 5000];
expr = N[Expand[expr, x], 5000];
NSolve[expr == 0, x, WorkingPrecision -> Infinity]
`

-
Exactly when I tried to rationalize the expression, then the answers seems right. It is suggested to rationalize the expression when dealing with such steep polynomials. – Zhong Sep 7 '13 at 2:11