Code-Beispiel

Allgemeines arithmetisches Mittel

Lizenz:	Erster Autor:	Letzte Bearbeitung:
k. A.	ytwinky	20.08.2010

Gelegentlich ist das einfache arithmetische Mittel nicht ausreichend, um einen aussagekräftigen Wert zu ermitteln. Wir benutzen wieder die Meßreihe vom allgemeinen arithmetischen Mittel.Das Meßverfahren ist diesmal aber ein anderes: Oma(75), Opa(81), Papa(51), Mama(35), Sohn(14), Tochter(12) haben mit einer Stoppuhr die Laufzeit eines Programmes gemessen. Bedingt durch die unterschiedlichen Reaktionszeiten der Teilnehmer können die ermittelten Werte nun aber nicht mehr als gleichwertig angesehen werden. Wenn wir jetzt das Alter als Kriterium für die Wertigkeit(Gewicht) nehmen, bekäme der Wert von Opa das höchste, der von Tochter das geringste Gewicht. Das entspricht bestimmt nicht der Realität. Deshalb benutzen wir als Gewicht den reziproken Wert des Alters und speichern ihn durch ein Komma ',' getrennt beim zugehörigen Meßwert. In der Literatur(s. Walter Großmann, Grundzüge der Ausgleichungsrechnung) wird darauf hingewiesen, daß Gewichte nicht stark von 1 abweichen sollen, also addieren wir einfach die 1 zu unseren Gewichten. Die Wahl der Gewichte steht uns ja frei, sie muß nur in einem begründbaren Zusammenhang zu den Meßwerten stehen. Unsere Datei sieht dann so aus:

;Auswertung vom 16.06.2007

15.14, 1.0133

14.983, 1.0123

15.05, 1.0196

14.97, 1.0285

15.017, 1.0714

14.840, 1.0833

(Abspeichern als AAM.Dat)
Tatsächlich ist die Ermittlung von Gewichten nicht immer einfach und das hier gezeigte Verfahren dient nur einer lockeren Darstellungsweise. Wer sich näher dafür interessiert, kann sich ja mal das Buch von Großmann durchlesen..
Hier nun ein Programm, welches die Meßwerte aus AAM.Dat auswerten kann:

'Ä=Ž , Ö=™ , Ü=š ; ä=„ , ö=”, ü= , ß=á ,§=õ , ©=¸ ,°=ø

#define Real Single 'reicht fürs Beispiel

Type Beobachtung

  As Real Messwert, Gewicht, Verbesserung

End Type



Declare Sub Einlesen(Daten() As Beobachtung)

Declare Function Berechnen(Daten() As Beobachtung, byRef SummeP As Real, byRef m0 As Real) As Real

Declare Sub Ausgeben(Daten() As Beobachtung, byVal MittelWert As Real, byVal SummeP As Real, byVal m0 As Real)

Const Esc=!"\27" 'So kann die Datei erst ab 0.17f kompiliert werden :D sonst wäre Esc=Chr(27)

Const MinMw=2 'Mindestanzahl der Messungen ist 2, dann ist aber die Fehlerrechnung nicht aussagekräftig

Dim As Real Mittelwert, SummeP, m0

Dim Daten() As Beobachtung

Dim Shared Anzahl As Integer, DateiName As String



Sub Einlesen(Daten() As Beobachtung)

  Dim As Integer i=0, OpenErr, DateiNr=FreeFile

  Dim As String Zeile

  DateiName=Command(1)

  Do

    OpenErr=Open(DateiName For Input As #DateiNr)

    If OpenErr<>0 Then

      If OpenErr<>2 Then

        Print "Fehler beim Öffnen der Datei, Programmende"

        GetKey

        End

      Else

        Print "Datei " &DateiName &" existiert nicht!"

        Input "Neuer Dateiname(Enter beendet):", DateiName

        If DateiName="" Then End

      End If

    End If

  Loop Until OpenErr=0

  Print "Fehler in der Datei " &DateiName &" Ctrl-C fr Abbruch.."

  Do

    Do

      Input #DateiNr, Zeile 'Pro Zeile ein Wert mit Dezimal'.' kein ',' als Schikane :D

      OpenErr=InStr(Zeile, ";") 'mit ';' können Zeilen auskommentiert werden

      If OpenErr Then Zeile=Left(Zeile, OpenErr-1) '..auch sinnvoll zum Kennzeichnen einer Meßreihe

    Loop Until Zeile<>"" 'Leerzeile überlesen

    ReDim Preserve Daten(i)

    Daten(i).Messwert=Val(Zeile)

    Input #DateiNr, Daten(i).Gewicht ' das Gewicht p ist vom Meßwert durch ein ',' getrennt

    i+=1

  Loop Until Eof(DateiNr)

  Close(DateiNr)

  Cls

  If i<MinMw Then

    Print MinMw &" Meáwerte sind mindestens erforderlich, vorhanden sind " &i

    Print "Mehr messen.."

    GetKey

    End

  End If

  Anzahl=i

End Sub



Function Berechnen(Daten() As Beobachtung, byRef SummeP As Real, byRef m0 As Real) As Real

  Dim As Integer i

  Dim As Real Mittel, SummePVV, SummePV, v

  For i=LBound(Daten) To Anzahl-1

    Mittel+=Daten(i).Messwert*Daten(i).Gewicht

    SummeP+=Daten(i).Gewicht

  Next i 'esistnichtegalwashierstehtauchwenneszusammengeschreibenist

  Mittel/=SummeP 'Mittelwert ausrechnen

  Redim As Beobachtung Verbesserung(Anzahl) 'Da im Hauptprogramm bereits vereinbart, neu dimensionieren

  For i=LBound(Daten) To Anzahl-1

    With Daten(i)

      .Verbesserung=Mittel-.Messwert

      v=.Verbesserung*.Gewicht

      SummePVV+=.Verbesserung*v

      SummePV+=v

    End With

  Next

  If Anzahl>=MinMw Then m0=Sqr(SummePVV/(Anzahl-1)) 'mittl. Fehler berechnen

  Function=Mittel

End Function



Sub Ausgeben(Daten() As Beobachtung, byVal MittelWert As Real, byVal SummeP As Real, byVal m0 As Real)

  Dim Mw As String="Mittelwert=", j As Integer=Len(Mw), Rand As String=String(j, 32)

  Dim As Integer i

  Dim As Real SummeV

  Print "Allgemeines arithmetisches Mittel ¸2007 by ytwinky, MD"

  Print "Auswertung der Datei " &DateiName &" mit " &Anzahl &" Meáwerten"

  Print Rand &"     Meáwert l       Gewicht p  Verbesserung v  Mittl. Fehler"

  For i=LBound(Daten) To Anzahl-1

    Print Rand;

    With Daten(i)

      Print Using "########.#####"; .Messwert; .Gewicht; .Verbesserung; m0/Sqr(.Gewicht)

      SummeV+=.Verbesserung

    End With

  Next

  Print Rand &"--------------"

  Print Mw;

  Print Using "########.#####"; MittelWert;

  Print String(14, 32);

  Print Using "########.#####";  SummeV

  Print Rand &"=============="

  Print "Summe der Verbesserungen muá=0 sein(oder ganz dicht dabei)"

  Print "(Für jede Meáwertzeile gilt: Mittelwert=Meáwert+Verbesserung)"

  If Anzahl>MinMw Then

    Print

    Print "Genauigkeitsbetrachtung"

    Print "m0=";

    Print Using "#.#####"; m0

    Print "Mittl. Fehler des gewichteten Mittelwertes=";

    Print Using "#.#####"; m0/Sqr(SummeP);

  End If

  GetKey

End Sub



'HauptProgramm

Einlesen(Daten()) 'Eingabe

Mittelwert=Berechnen(Daten(), SummeP, m0) 'Verarbeitung

Ausgeben(Daten(), MittelWert, SummeP, m0) 'Ausgabe

'Ende

Fragen zum Programm? Nun, dann kann ich wirklich nur das Buch von Großmann empfehlen..
Interessant ist auch, die Gewichte alle auf 1 zu setzen, aber wer das einfache arithmetische Mittel schon hat, findet das vielleicht weniger spannend :D
Gruß
ytwinky

Zusätzliche Informationen und Funktionen

Das Code-Beispiel wurde am 16.06.2007 von ytwinky angelegt.
Die aktuellste Version wurde am 20.08.2010 von ytwinky gespeichert.

Bearbeiten

Versionen