Declare Function horner#(x As Double, ko() As Double) Declare Sub ableitung(ko() As Double, ko1a() As Double) Declare Sub nullex(von As Double, bis As Double, schritt As Double, k() As Double) Type nuex x As Double ' x f As Double ' f(x) f1a As Double ' f'(x) f2a As Double ' f''(x) End Type Dim Shared n As nuex ReDim ko(1) As Double Dim von As Double Dim bis As Double Dim schritt As Double Dim xvor As Double Dim i As Integer ReDim ko(5) ko(1) = 1 ko(2) = 5 ko(3) = 5 ko(4) = -5 ko(5) = -6 'polynom auf bildschirm ausgeben Cls For i = 1 To UBound(ko) - 1 Print " "; If (ko(i) >= 0) And (i <> 1) 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 von = -10 bis = 10 schritt = .001 xvor = horner(von - schritt,ko()) Do Call nullex(von, bis, (schritt), ko()) '1. nullstelle und/oder 1. extremwert suchen If n.x > bis Then 'ende des intervalls erreicht Exit Do EndIf If n.f = 0 Then Print "Nullstelle "; EndIf If n.f1a = 0 Then ' f'(x) = 0 --> extremwert If n.f2a = 0 Then ' f''(x) = 0 Print "Wendepunkt "; ElseIf Sgn(n.f2a) = -1 Then ' f''(x) < 0 Print " Maximum "; ElseIf Sgn(n.f2a) = 1 Then ' f''(x) > 0 Print " Minimum "; EndIf EndIf Print n.x von = n.x + schritt 'weitersuchen Loop Print Print "OK" Sleep End Function horner#(x As Double, k() As Double) Dim f As Double Dim i As Integer '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 nullex(von As Double, bis As Double, schritt As Double, k() As Double) Dim xvor As Double Dim fvor As Double Dim f1avor As Double Dim xm As Double ReDim k1a(1) As Double ReDim k2a(1) As Double Dim flag As String xvor = von fvor = horner(xvor,k()) Call ableitung(k(),k1a()) '1. ableitung f1avor = horner(xvor,k1a()) Call ableitung(k1a(),k2a()) '2. ableitung n.x = von Do n.f = horner(n.x,k()) n.f1a = horner(n.x,k1a()) If n.f = 0 Then Exit Sub ElseIf (Sgn(n.f) <> Sgn(fvor)) Or (Sgn(n.f1a) <> Sgn(f1avor)) Then Do schritt = (n.x - xvor) / 2 xm = xvor + schritt If Str$(xm) = Str$(xvor) Then 'genauigkeitsgrenze erreicht n.x = xm Select Case flag Case "n" n.f = 0 ' f(x) = 0 setzen Case "e" n.f1a = 0 ' f'(x) = 0 setzen End Select Exit Sub EndIf n.f = horner(xm,k()) n.f1a = horner(xm,k1a()) n.f2a = horner(xm,k2a()) If (n.f = 0) Or (n.f = fvor) Then 'nullstelle oder gleicher funktionswert n.x = xm Select Case flag Case "n" n.f = 0 ' f(x) = 0 setzen Case "e" n.f1a = 0 ' f'(x) = 0 setzen End Select Exit Sub ElseIf (Sgn(n.f) <> Sgn(fvor)) Or (Sgn(n.f1a) <> Sgn(f1avor)) Then If Sgn(n.f) <> Sgn(fvor) Then flag = "n" 'nullstelle Else flag = "e" 'extremwert EndIf n.x = xm 'nullstelle/extremwert liegt zwischen xvor und xm Else xvor = xm 'nullstelle/extremwert liegt zwischen xm und n.x fvor = n.f f1avor = n.f1a EndIf Loop EndIf xvor = n.x 'werte merken fvor = n.f f1avor = n.f1a n.x = n.x + schritt Loop Until n.x > bis 'ende des intervalls erreicht Select Case flag Case "n" n.f = 0 ' f(x) = 0 setzen Case "e" n.f1a = 0 ' f'(x) = 0 setzen End Select Exit Sub End Sub Sub ableitung(k() As Double, k1a() As Double) Dim i As Integer Dim grad As Integer grad = UBound(k) ReDim k1a(grad - 1) 'koeffizientenarray für 1. ableitung anlegen For i = 1 To grad - 1 '1. ableitung bilden k1a(i) = k(i) * (grad - i) Next End Sub