Die Community zu .NET und Classic VB.
Menü

VB.NET-Tipp 0144: Gewöhnliche Differentialgleichungen lösen

 von 

Beschreibung

Viele Naturgesetze und mathematische Probleme lassen sich in einer Art und Weise formulieren, in der neben einer unbekannten Größe auch deren Änderungsrate (die Ableitung) auftritt. Möchte man beispielsweise die Bewegung eines Balles simulieren, spielen dafür nicht nur der Ort, sondern auch Geschwindigkeit und Beschleunigung des Balles eine Rolle und stehen miteinander in Beziehung.

Normalerweise geht man bei der Simulation einfach in sehr kleinen Zeitschritten vor und berechnet sukzessive neue Ergebnisse und Ableitungen. Allerdings entstehen dabei Ungenauigkeiten, die sich aufsummieren können und das Ergebnis verfälschen. Mit der Wahl eines besseren Näherungsverfahrens wie dem hier vorgestellten Runge-Kutta-Verfahren kann man bei der gleichen Anzahl an Schritten genauere Ergebnisse erhalten. Der Tipp implementiert zwei Verfahren und zeigt vergleichend deren Genauigkeit.

Schwierigkeitsgrad:

Schwierigkeitsgrad 2

Framework-Version(en):

.NET Framework 3.0, .NET Framework 3.5, .NET Framework 4

.NET-Version(en):

Visual Basic 2008, Visual Basic 2010

Download:

Download des Beispielprojektes [12,11 KB]

' Dieser Quellcode stammt von http://www.activevb.de
' und kann frei verwendet werden. Für eventuelle Schäden
' wird nicht gehaftet.

' Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum.
' Ansonsten viel Spaß und Erfolg mit diesem Source!

' Projektversion:   Visual Studio 2008
' Option Strict:    An
' Option Explicit:  An
' Option Infer:     An
'
' Referenzen: 
'  - System
'  - System.Data
'  - System.Deployment
'  - System.Drawing
'  - System.Windows.Forms
'  - System.Xml
'  - System.Core
'  - System.Xml.Linq
'  - System.Data.DataSetExtensions
'
' Imports: 
'  - Microsoft.VisualBasic
'  - System
'  - System.Collections
'  - System.Collections.Generic
'  - System.Data
'  - System.Drawing
'  - System.Diagnostics
'  - System.Windows.Forms
'  - System.Linq
'  - System.Xml.Linq
'

' ##############################################################################
' ################################# Form1.vb ###################################
' ##############################################################################
Option Strict On

Imports System.Math

Public Class frmMain

    ' Unsere Testfunktion definieren

    ' Startwert = 1
    Dim y0 As Double = 1

    ' Zum Vergleich: f(x) = e^(0.03x)
    Dim f As MathFunction = Function(x) Exp(0.03 * x)

    ' Unsere Differenzialgleichung für f: f'(x) = 0.03*f(x)
    Dim df As Derivative = Function(x, y) 0.03 * y

    Private Sub numH_ValueChanged(ByVal sender As System.Object, _
                                  ByVal e As System.EventArgs) _
                                  Handles numH.ValueChanged

        Dim Image = New Bitmap(PictureBox1.Width, PictureBox1.Height)

        Dim h = numH.Value

        Using g = Graphics.FromImage(Image)
            g.SmoothingMode = Drawing2D.SmoothingMode.HighQuality

            ' Koordinatensystem zeichnen
            g.DrawLine(Pens.Black, 0, PictureBox1.Height \ 2, _
                       PictureBox1.Width, PictureBox1.Height \ 2)
            g.DrawLine(Pens.Black, PictureBox1.Width \ 2, 0, _
                       PictureBox1.Width \ 2, PictureBox1.Height)

            ' Näherungen zeichnen
            ShowGraph(AddressOf Euler, h, Color.Red, g)
            ShowGraph(AddressOf RK4, h, Color.Blue, g)

            ' Exakte Funktion zum Vergleich zeigen
            ShowGraph(Function(_d, x, _y, _h) f(x), 1, Color.Green, g)
        End Using

        PictureBox1.Image = Image
    End Sub

    ' Graph für einen gegebenen Näherungsalgorithmus zeichnen
    Sub ShowGraph(ByVal Algo As Func(Of Derivative, Double, _
                                     Double, Double, Double), _
                  ByVal h As Double, _
                  ByVal Color As Color, _
                  ByVal g As Graphics)


        Dim x = 0.0
        Dim y = y0
        Dim Points As New List(Of PointF)

        ' Funktionswerte mit der Näherung ausrechnen...
        For i = 0 To Width Step h
            Points.Add(New PointF(CSng(x), CSng(y)))
            y = Algo(df, x, y, h)
            x += h
        Next

        Using Pen = New Pen(Color)
            g.DrawLines(Pen, Transform(Points, _
                                       PictureBox1.Width, PictureBox1.Height))
        End Using
    End Sub

    ' Punkte in unser Koordinatensystem umrechnen
    Private Function Transform(ByVal Points As IEnumerable(Of PointF), _
                               ByVal Width As Integer, _
                               ByVal Height As Integer) As PointF()
        Dim Points2 = From Pnt In Points _
                      Where (Not Double.IsInfinity(Pnt.Y)) _
                        AndAlso (Pnt.Y <= 10 * Height) _
                        AndAlso (Pnt.Y > 0) _
                      Select New PointF(CSng(Width / 2 + Pnt.X), _
                                        CSng(Height / 2 - Pnt.Y))
        Return Points2.ToArray()
    End Function
End Class

' ##############################################################################
' ################################## ODE.vb ####################################
' ##############################################################################
Option Strict On

Imports System.Math

Public Module ODE
    Public Delegate Function MathFunction(ByVal x As Double) As Double
    Public Delegate Function Derivative(ByVal x As Double, _
                                        ByVal y As Double) As Double

    ' Euler-Verfahren
    Public Function Euler(ByVal df As Derivative, ByVal x As Double, _
                          ByVal y As Double, ByVal h As Double) As Double
        Return y + df(x, y) * h
    End Function

    ' Runge-Kutta-Verfahren (RK4)
    Public Function RK4(ByVal df As Derivative, ByVal x As Double, _
                        ByVal y As Double, ByVal h As Double) As Double

        Dim k1 = df(x, y)
        Dim k2 = df(x + h / 2, y + h * k1 / 2)
        Dim k3 = df(x + h / 2, y + h * k2 / 2)
        Dim k4 = df(x + h, y + h * k3)

        Return y + h * (k1 + 2 * k2 + 2 * k3 + k4) / 6
    End Function
End Module

Ihre Meinung  

Falls Sie Fragen zu diesem Artikel haben oder Ihre Erfahrung mit anderen Nutzern austauschen möchten, dann teilen Sie uns diese bitte in einem der unten vorhandenen Themen oder über einen neuen Beitrag mit. Hierzu können sie einfach einen Beitrag in einem zum Thema passenden Forum anlegen, welcher automatisch mit dieser Seite verknüpft wird.