Access Blog

Bei der Auswertung einer Punktewolke sucht man die Punkt-Steigungs-Formel einer Geraden die den Zusammenhang zwischen zwei Zahlenmengen darstellt. Mittels dieser Formel – die allseits aus dem Schulunterricht bekannt sein dürfte – lassen sich zuverlässige Schätzwerte für zukünftige Rechenwerte berechnen da man annimmt dass diese dann nahe der Gerade liegen. Gesucht wird die Geradensteigung m sowie den Durchstoßpunkt der Geraden auf der Y-Achse:

Bevor man mit der Berechnung der Werte beginnt, sind die Mittelwerte der Koordinaten xquer und yquer zu berechnen. Das geht einfach indem man die Summer der Messwerte durch deren Anzahl teilt.
Die Steigung m berechnet sich aus dem Quotient der Summe von xi-xquer mal yi-yquer und der Summe von xi-xquer im Quadrat. Die nachfolgende Abbildung verdeutlicht das:

Der Durchstoßpunkt b der Y-Achse ermittelt sich durch die Differenz von yquer und dem Produkt von m und xquer:

Auf Access übertragen bedeutet dies, dass man zuerst die Mittelwerte berechnet, danach in einer Schleife über alle Punktepaare x,y die Zähler nach obiger Formel aufsummiert und die Nenner aufsummiert und danach den Quotient bestimmt, wie nachfolgender Codeauszug verdeutlicht:

'Mittelwerte berechnen
xquer = meanxy(arrX)
yquer = meanxy(arrY)

'RechenWerte 1 und 2 ermitteln
For i = 0 To UBound(arrX)
RechWert1 = RechWert1 + (arrX(i) - xquer) * (arrY(i) - yquer)
RechWert2 = RechWert2 + (arrX(i) - xquer) * (arrX(i) - xquer)
Next i

'y = mx + b
m = RechWert1 / RechWert2
b = yquer - m * xquer

Die Messwerte liegen in 2 Arrays vor, eines davon die X-Komponente, das andere die Y-Komponente.
Um nun einen Graphen sowie die Punktwolke zu zeichnen, bediene ich mich wieder der PictureBox Klasse von Stephen Lebans, die bereits an anderer Stelle vorgestellt wurde.

Zum Zeichnen von Linien und Kreisen habe ich mir 2 Routinen erstellt, die berücksichtigen dass ein gewisser Randabstand eingehalten wird und dass die y-Achse gespiegelt wird (der Punkt 0/0 wäre sonst links oben).

Private Sub lineDraw(x1 As Double, y1 As Double, x2 As Double, y2 As Double, pb As clsPictureBox, Optional lColor As Long = 0)
    pb.DrawLine x1 + Offset, hoehe - y1 - Offset, x2 + Offset, hoehe - y2 - Offset, 0
End Sub

Private Sub circleDraw(leftX As Long, topY As Long, diameter As Long, pb As clsPictureBox, Optional fillColor As Long = 0)
    pb.ForeColor = 0
    pb.DrawCircle leftX * pb_Scale + Offset, hoehe - (topY * pb_Scale) - Offset, diameter, fillColor
End Sub

Eine weitere Hilfsroutine stellt den Scalenfaktor ein:

Private Sub setScale(arrX As Variant, arrY As Variant)
    Dim i As Long
    Dim maxx As Double
    Dim maxy As Double
    For i = 0 To UBound(arrX)
        If maxx < arrX(i) Then
            maxx = arrX(i)
        End If
        If maxy < arrY(i) Then
            maxy = arrY(i)
        End If
    Next i
    ScaleX = (breite - 50) / maxx
    ScaleY = (hoehe - 50) / maxy
    pb_Scale = min(ScaleX, ScaleY)
End Sub

Die eigentliche Prozedur die den Graphen und die Punktewolke zeichnet ist diese:

Private Sub drawGraph(arrX As Variant, arrY As Variant, pb As clsPictureBox)
    Dim i As Long
    Dim x1 As Long, y1 As Long, x2 As Long, y2 As Long
    pb.Clear

    hoehe = pb.dib_height
    breite = pb.dib_width
    Offset = 10

    setScale arrX, arrY
    drawAxis pb

    'Punktewolke zeichnen
    For i = 0 To UBound(arrX)
        circleDraw CDbl(arrX(i)), CDbl(arrY(i)), 10, pb
    Next i

    'Korrelationsgerade zeichnen
    x2 = 0
    x1 = CLng(breite - 50)
    y2 = CLng(b * pb_Scale)
    y1 = CLng((m * (breite - 50) / pb_Scale + b) * pb_Scale)
    lineDraw CLng(x1), CLng(y1), CLng(x2), CLng(y2), pb
End Sub

Weitere Prozeduren die hier nicht genannt sind sind z.B. dafür da um das Achsenkreuz zu zeichnen, oder die PictureBox zu initialisieren.
Wer daran Interessiert ist bekommt von mir gerne das Beispielprojekt.

Eine Abbildung wie das z.B. aussehen könnte zeigt das nachfolgende Bild:

Bis dahin
Andreas Vogt ©2011