Bir polinomun gerçek köklerini bulun

Bir polinom verildiğinde ve bir ciltlendiğinde, o polinomun tüm gerçek köklerini bu sınırı aşmayan mutlak bir hataya bulabilecek kendi kendine yeten bir program yazın.

Kısıtlamalar

Mathematica ve muhtemelen diğer bazı dillerin tek sembollü bir çözümü olduğunu biliyorum ve bu çok sıkıcı, bu yüzden ilkel işlemlere (toplama, çıkarma, çarpma, bölme) bağlı kalmalısınız.

Giriş ve çıkış formatlarında belirli bir esneklik var. Herhangi bir makul formatta stdin veya komut satırı argümanları ile giriş yapabilirsiniz. Kayan noktaya izin verebilir veya bazı rasyonel sayılar gösteriminin kullanılmasını isteyebilirsiniz. Sınırını veya sınırın karşılığını alabilir ve kayan nokta kullanıyorsanız, bağın 2 ulp'den az olmayacağını varsayabilirsiniz. Polinom, monomiyal katsayıların bir listesi olarak ifade edilmelidir, fakat büyük veya küçük endian olabilir.

Programın neden her zaman işe yarayacağını haklı gösterebilmelisiniz (satır içi tam kanıtlar sağlamanız gerekmese de).

Program tekrarlanan kökleri olan polinomları işlemelidir.

Örnek

x^2 - 2 = 0 (error bound 0.01)

Giriş örneğin olabilir

-2 0 1 0.01
100 1 0 -2
1/100 ; x^2-2

Çıktı örneğin olabilir

-1.41 1.42

Ama değil

-1.40 1.40

Bu yaklaşık 0,014 mutlak hatalara sahip ...

Test durumları

Basit:

x^2 - 2 = 0 (error bound 0.01)

x^4 + 0.81 x^2 - 0.47 x + 0.06 (error bound 10^-6)

Birden çok kök:

x^4 - 8 x^3 + 18 x^2 - 27 (error bound 10^-6)

Wilkinson'ın polinomu:

x^20 - 210 x^19 + 20615 x^18 - 1256850 x^17 + 53327946 x^16 -1672280820 x^15 +
    40171771630 x^14 - 756111184500 x^13 + 11310276995381 x^12 - 135585182899530 x^11 +
    1307535010540395 x^10 - 10142299865511450 x^9 + 63030812099294896 x^8 -
    311333643161390640 x^7 + 1206647803780373360 x^6 -3599979517947607200 x^5 +
    8037811822645051776 x^4 - 12870931245150988800 x^3 + 13803759753640704000 x^2 -
    8752948036761600000 x + 2432902008176640000  (error bound 2^-32)

Not Bu soru yaklaşık 3 aydır Sandbox'taydı . Göndermeden önce iyileştirilmesi gerektiğini düşünüyorsanız, Sandbox'ı ziyaret edin ve Main'e gönderilmeden önce önerilen diğer sorular hakkında yorum yapın .

Mathematica, 223

r[p_,t_]:=Module[{l},l=Exponent[p[x],x];Re@Select[NestWhile[Table[#[[i]]-p[#[[i]]]/Product[If[i!=j,#[[i]]-#[[j]],1],{j,l}],{i,l}]&,Table[(0.9+0.1*I)^i,{i,l}],2*Max[Table[Abs[#1[[i]]-#2[[i]]],{i,l}]]>t&,2],Abs[Im[#]]<t^.5&]]

Bu çözüm, polinomları çözmek için Durand-Kerner yöntemini uygular. Bunun tam bir çözüm olmadığını unutmayın (aşağıda gösterildiği gibi) çünkü Wilkinson Polinomunu henüz belirtilen hassasiyetle idare edemiyorum. İlk önce ne yaptığımın bir açıklaması:

#[[i]]-p[#[[i]]]/Product[If[i!=j,#[[i]]-#[[j]],1],{j,l}]&: Böylece fonksiyon her indeks iiçin bir sonraki Durand-Kerner yaklaşımını hesaplar . Daha sonra bu çizgi bir Tabloda saklanır ve tarafından üretilen giriş noktalarına bir NestWhile kullanılarak uygulanır Table[(0.9+0.1*I)^i,{i,l}]. NestWhile'daki koşul, bir yinelemeden diğerine maksimum değişimin (tüm terimler arasında) belirtilen hassasiyetten büyük olmasıdır. Tüm terimler bundan daha az değiştiğinde, NestWhile biter ve Re@Selectgerçek satıra düşmeyen sıfırları kaldırır.

Örnek çıktı:

> p[x_] := x^2 - 2
> r[p, .01]
{1.41421, -1.41421}

> p[x_] := x^4 - 8 x^3 + 18 x^2 - 27
> r[p, 10^-6]
{2.99999, 3., 3.00001, -1.}

> p[x_] := x^20 - 210 x^19 + ... + 2432902008176640000 (Wilkinson's)
> Sort[r[p, 2^-32]]
{1., 2., 3., 4., 5., 6., 7.00001, 7.99994, 9.00018, 10.0002, 11.0007, \
11.9809, 13.0043, 14.0227, 14.9878, 16.0158, 16.9959, 17.9992, \
19.0001, 20.}

Muhtemelen görebildiğiniz gibi, derece yükseldikçe, bu yöntem doğru değerlerin etrafında zıplamaya başlar, hiçbir zaman tam olarak hedeflenmez. Kodumun durma koşulunu "bir yinelemeden bir sonrakine epsilondan daha fazla değişmeyen tahminlere" göre daha katı bir şey olarak ayarlarsam, algoritma asla durmaz. Sanırım sadece Durand-Kerner'i Newton'un metoduna girdi olarak kullanmalı mıyım?