Declare Function horner#(x#,k#())
Declare Sub ableitung()
Declare Function newton#(anf#)
Declare Sub poldiv(n#)

ReDim Shared ko#(1), nullstelle#(1), kd#(1), ko1a#(1)

Dim x#
Dim i%, n%, j%

On Error GoTo fehler

ReDim ko#(4)
ko#(1) = 1
ko#(2) = -2
ko#(3) = -5
ko#(4) = 6

'ReDim ko#(4)
'ko#(1) = 1
'ko#(2) = 4
'ko#(3) = 1
'ko#(4) = -3

'ReDim ko#(5)
'ko#(1) = 1
'ko#(2) = 5
'ko#(3) = 5
'ko#(4) = -5
'ko#(5) = -6

'ReDim ko#(4)
'ko#(1) = 3
'ko#(2) = -10
'ko#(3) = 7
'ko#(4) = -12

Cls

'polynom auf bildschirm ausgeben
For i% = 1 To UBound(ko#) - 1
	Print " ";
	If ko#(i) > 0 Then 
		Print "+";
	EndIf
	Print Str$(ko#(i));"x^";Str$(UBound(ko#) - i);
Next
Print " ";
If ko#(UBound(ko#)) > 0 Then 
		Print "+";
	EndIf
Print Str$(ko#(UBound(ko#)))
Print
Print

'nullstellen berechnen
ReDim nullstelle#(UBound(ko#) + 1)
i% = 1
Do
	nullstelle#(i%) = newton#(0) 'nullstelle suchen
	'If Str$(nullstelle#(i%)) = "-1.#INF" Then 'keine (weitere) nullstelle gefunden
	If nullstelle#(i%) = 1.1D+308 Then 'keine (weitere) nullstelle gefunden
		If i% = 1 Then
			Print "keine Nullstellen"
		EndIf
		Exit Do
	EndIf
	Print i%;". Nullstelle ";nullstelle#(i%) 'nullstelle auf bildschirm
	poldiv(nullstelle#(i%)) 'polynomdivision durchführen
	i% = i% + 1
	ReDim ko#(UBound(kd#)) 'koeffizientenarray verkleinern
	For j% = 1 To UBound(kd#) 'koeffizienten übertragen
		ko#(j%) = kd#(j%)
	Next
Loop

Print
Print "OK"
Sleep
End

fehler:
Print
Print "OK"
Sleep
End


Function horner#(x#,k#())
	Dim f#
	Dim i%
	
	'funktionswert mithilfe des horner - schemas berechnen
	f# = k#(1)
	For i% = 2 To UBound(k#)
		f# = f# * x# + k#(i%)  
	Next
	horner# = f#
End Function

Sub ableitung
	Dim grad%, i%
	
	grad% = UBound(ko#)
	
	ReDim ko1a#(grad% - 1) 'koeffizientenarray für 1. ableitung anlegen
	For i% = 1 To grad% - 1 '1. ableitung bilden
		ko1a#(i%) = ko#(i%) * (grad% - i)
	Next
End Sub

Function newton#(anfang#)
	Dim x#, xvor#
	ReDim ko1a#(1)
	Dim i%
	
	x# = anfang#
	ableitung '1. ableitung des polynoms bilden
	For i% = 1 To 10000 'maximal 10000 schritte
		If Abs(horner(x#,ko1a#())) < 1.0e-20 Then
			newton# = 1.1D+308
			Exit Function
		EndIf
		x# = x# - (horner(x#,ko#()) / horner(x#,ko1a#())) 'iterationsschritt durchführen
		'? "~";x#
		If x# = xvor# Then 'wert verändert sich nicht mehr -> maximale genauigkeit erreicht
			newton# = x#
			Exit Function
		EndIf
		xvor# = x# 'vorherigen wert merken
	Next
	newton# = x#
End Function

Sub poldiv(n#)
	Dim i%
	ReDim kd#(UBound(ko#) - 1)
	ReDim karb#(UBound(ko#))
	
	For i% = 1 To UBound(ko#) 'koeffizienten in arbeitskopie übertragen
		karb#(i%) = ko#(i%)
	Next
	
	'polynomdivision durchführen
	For i% = 1 To UBound(kd#)
		kd#(i%) = karb#(i%)
		karb#(i% + 1) = karb#(i% + 1) + (karb#(i%) * n#)
	Next
End Sub