Bisektion

Ausgangspunkt des letzten Posts war die Frage, wie man mit VBA den Schnittpunkt zweier Geraden berechnen kann. Beendet wurde der Artikel mit einer Klasse zum Erstellen von beliebigen Polynomen. Nun wollen wir die Nullstellen dieser Polynome mit VBA bestimmen.

Um die Nullstelle des Polynoms zu bestimmen werden wir das Bisektion- oder auch Intervallhalbierungsverfahren verwenden.

Bisektion

Wie funktioniert dieses Verfahren? Das Beispiel von Wikipedia sollte jedem noch aus der Kindheit geläufig sein.

"Gesucht ist eine Zahl zwischen 1 und 1.000. Die soll ein Spieler erraten, er erhält als Hinweis immer nur „größer“ oder „kleiner“ oder „Treffer“."

Der erste Rateversuch ist (fast) immer die 500, anschließend die 250 bzw. 750, usw. Man halbiert also das Intervall und beschränkt sich dann bei der Suche auf eines der Teilintervalle.

Der VBA-Code

Die Umsetzung von Bisektion in VBA könnte - unter Verwendung unserer Klasse clsPolynom - zum Beispiel so aussehen:

Public Function BiSection(Funktion As clsPolynom, ByVal Von As Double _
            , ByVal Bis As Double, Genauigkeit As DoubleAs Double
    Dim Schrittweite As Double
    Dim Mitte As Double

    'BiSection benötigt genau eine Nullstelle im Intervall [von, bis]
    'Wenn eine Nullstelle in [von, bis] existiert, sind die _
        Vorzeichen y(von) und y(bis) verschieden

    'Falls die Vorzeichen y(von) und y(bis) gleich sind, ist das _
        Produkt y(von)*y(bis) größer 0

    'Falls das Produkt y(von)*y(bis) größer 0, kann BiSection nicht _
        angewendet werden => Abbruch!

    If Funktion.y(Von) * Funktion.y(Bis) > 0 Then
        Exit Function
    End If

    Schrittweite = Bis - Von
    Do While Schrittweite > Genauigkeit
        'Betrachte die Punkte Von, Bis und die Mitte
        Mitte = Von + (Bis - Von) / 2
        'Findet der Vorzeichenwechsel zwischen Von und Mitte oder _
            zwischen Mitte und Bis statt?

        If Funktion.y(Von) * Funktion.y(Mitte) < 0 Then
            'Neues Intervall [Von, Mitte]
            Bis = Mitte
        Else
            'Neues Intervall [Mitte, Bis]
            Von = Mitte
        End If
        'Halbiere die Schrittweite und loop
        Schrittweite = Schrittweite / 2
    Loop
    'Rückgabe der Nullstelle
    BiSection = Mitte
End Function

Code eingefügt mit Syntaxhighlighter 4.15

Der Test

Wollen wir doch mal einen kleinen Test durchführen. Wir nehmen die Polynomfunktion y=x^2-2. Die beiden Nullstellen sind +/-1.4142135623731. Startwerte für die Bisektion sind 0 und 10.

Public Sub Main()
    Dim Von As Double, Bis As Double
    Dim Genauigkeit As Double
    Dim Funktion As clsPolynom

    Set Funktion = New clsPolynom
    Funktion.Vorfaktoren = Array(-2, 0, 1)
    'y =1*x^2 + 0*x - 2 -> 2=x^2 -> x = +/-wurzel(2) = +/-1.4142135623731

    'Startwerte für BiSection
    Von = 0
    Bis = 10
    Genauigkeit = 0.0001

    Debug.Print BiSection(Funktion, Von, Bis, Genauigkeit)
End Sub

Code eingefügt mit Syntaxhighlighter 4.15

Genauigkeit und Performance

Das Bisections-Verfahren führt in diesem Beispiel schon nach 15 Iterationen zu einem guten Ergebnis. Wichtig ist aber eine GUTE Wahl des ersten Intervalls! Eine schlechte Wahl des ersten Intervalls führt zu einem Abbruch des Algorithmus.

Im nächsten Blog werde ich noch eine Alternative zu Bisection vorstellen und zeigen, wie damit der Schnittpunkt zweier Funktionen bestimmt werden kann.

AnhangGröße
Bisection.jpg272.61 KB
clsTimer.cls1.36 KB
Bisection.bas3.09 KB
Your rating: Keine Average: 5 (1 vote)