ค้นหารากที่แท้จริงของพหุนาม

เขียนโปรแกรมที่มีอยู่ในตัวเองซึ่งเมื่อได้รับพหุนามและขอบเขตจะพบรากแท้จริงทั้งหมดของพหุนามนั้นไปสู่ข้อผิดพลาดสัมบูรณ์ไม่เกินขอบเขต

ข้อ จำกัด

ฉันรู้ว่า Mathematica และภาษาอื่นอาจมีวิธีแก้ปัญหาแบบสัญลักษณ์เดียวและนั่นก็น่าเบื่อดังนั้นคุณควรยึดติดกับการดำเนินงานดั้งเดิม (การบวกการลบการคูณการหาร)

มีความยืดหยุ่นบางอย่างในรูปแบบอินพุตและเอาต์พุต คุณสามารถรับอินพุตผ่าน stdin หรืออาร์กิวเมนต์บรรทัดคำสั่งในรูปแบบที่สมเหตุสมผล คุณอาจอนุญาตให้ใช้ทศนิยมหรือต้องการให้ใช้การแทนจำนวนตรรกยะ คุณอาจใช้ขอบเขตหรือส่วนกลับของขอบเขตและถ้าคุณใช้จุดลอยตัวคุณอาจสมมติว่าขอบเขตนั้นจะต้องไม่น้อยกว่า 2 ulp พหุนามควรจะแสดงเป็นรายการของสัมประสิทธิ์ monomial แต่มันอาจจะใหญ่หรือเล็ก - endian

คุณต้องสามารถพิสูจน์ได้ว่าทำไมโปรแกรมของคุณถึงใช้งานได้ตลอดเวลา (ปัญหาเชิงตัวเลขแบบโมดูโล) แม้ว่าจะไม่จำเป็นที่จะต้องพิสูจน์หลักฐานแบบอินไลน์

โปรแกรมจะต้องจัดการกับพหุนามด้วยรากซ้ำ

ตัวอย่าง

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

อินพุตอาจเป็นเช่น

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

ผลผลิตอาจเป็นเช่น

-1.41 1.42

แต่ไม่

-1.40 1.40

ตามที่มีข้อผิดพลาดแน่นอนประมาณ 0.014 ...

กรณีทดสอบ

ง่าย:

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

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

หลายราก:

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

พหุนามของ Wilkinson:

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)

NB คำถามนี้อยู่ในSandbox เป็นเวลาประมาณ 3 เดือน หากคุณคิดว่าจำเป็นต้องปรับปรุงก่อนโพสต์ให้ไปที่ Sandbox และแสดงความคิดเห็นเกี่ยวกับคำถามที่เสนออื่น ๆก่อนโพสต์บนหน้าหลัก

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&]]

วิธีนี้ใช้วิธี Durand – Kerner ในการแก้ชื่อพหุนาม โปรดทราบว่านี่ไม่ใช่วิธีการแก้ปัญหาที่สมบูรณ์ (ตามที่แสดงด้านล่าง) เพราะฉันยังไม่สามารถจัดการพหุนามของ Wilkinson ตามความแม่นยำที่ระบุได้ ก่อนอื่นให้อธิบายว่าฉันกำลังทำอะไรอยู่:

#[[i]]-p[#[[i]]]/Product[If[i!=j,#[[i]]-#[[j]],1],{j,l}]&: ดังนั้นฟังก์ชั่นคำนวณสำหรับแต่ละดัชนีiการประมาณค่า Durand-Kerner ถัดไป จากนั้นสายนี้ถูกห่อหุ้มในตารางและประยุกต์ใช้ NestWhile Table[(0.9+0.1*I)^i,{i,l}]ไปยังจุดการป้อนข้อมูลที่สร้างขึ้นโดย เงื่อนไขใน NestWhile คือการเปลี่ยนแปลงสูงสุด (มากกว่าทุกเงื่อนไข) จากการทำซ้ำหนึ่งไปยังอีกการถัดไปมากกว่าความแม่นยำที่ระบุ เมื่อคำศัพท์ทั้งหมดเปลี่ยนไปน้อยกว่านี้ NestWhile จะสิ้นสุดและRe@Selectลบค่าศูนย์ที่ไม่ตกอยู่บนเส้นจริง

ตัวอย่างผลลัพธ์:

> 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.}

อย่างที่คุณอาจเห็นเมื่อระดับการเติบโตสูงขึ้นวิธีนี้เริ่มเด้งค่าที่ถูกต้องไม่เคยกลับบ้านอย่างสมบูรณ์ ถ้าฉันตั้งเงื่อนไขการหยุดของรหัสของฉันให้เป็นอะไรที่เข้มงวดกว่า "จากการทำซ้ำหนึ่งไปเป็นอีกการเดาที่เปลี่ยนไปโดยไม่เกิน epsilon" อัลกอริทึมไม่เคยหยุด ฉันเดาว่าฉันควรใช้ Durand-Kerner เป็นวิธีป้อนข้อมูลในวิธีการของ Newton?