Buchempfehlung
Visual Basic 6 Kochbuch
Visual Basic 6 Kochbuch
Viele praktische Tipps zum Programmieren mit Visual Basic 6, die sich oft auch auf FB übertragen lassen. [Mehr Infos...]
FreeBASIC-Chat
Es sind Benutzer im FreeBASIC-Chat online.
(Stand:  )
FreeBASIC bei Twitter
Twitter FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!

Code-Beispiel

Code-Beispiele » Mathematik

Einfaches arithmetisches Mittel

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

Es gibt Fälle, in denen die Ermittlung von Meßwerten nur einem einzigen Zweck dient: Ein aussagekräftiger Mittelwert
Betrachten wir einfach mal die Laufzeit eines beliebigen Programmes. Da Windows (z.B.) zwischendurch auch noch andere Sachen erledigen muß, reicht es nicht aus, einfach nur Anfangs- und Endzeit zu ermitteln. Es ist auch ratsam, zu unterschiedlichen Zeitpunkten diese Messung durchzuführen.
Diese Meßwerte können wir in einer Datei sammeln und uns darüber freuen. Wenn aber die einzelnen Meßwerte voneinander abweichen, sind sie weniger interessant, wir benötigen den Mittelwert. Wir gehen einfach mal davon aus, daß die Zahlen alle mit demselben Verfahren ermittelt wurden, sodaß sie als gleichwertig betrachtet werden können.
Nehmen wir einfach mal folgende Zahlen als Rechenbeispiel:

;Auswertung vom 16.06.2007
15.14
14.983
15.05
14.97
15.017
14.840

(Diese Daten in der Datei EAM.Dat im Programmverzeichnis speichern..)
Das folgende Programm, welches absichtlich die Struktur Eingabe-Verarbeitung-Ausgabe einhält, berechnet daraus den Mittelwert:

'Ä=Ž , Ö=™ , Ü=š ; ä=„ , ö=”, ü= , ß=á ,§=õ , ©=¸ ,°=ø
#define Real Single 'reicht fürs Beispiel
Declare Sub Einlesen(Daten() As Real)
Declare Function Berechnen(Daten() As Real, v() As Real, byRef mf As Real) As Real
Declare Sub Ausgeben(Daten() As Real, v() As Real, byVal MittelWert As Real, byVal mf 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, mittlFehler, Daten(), Verbesserung()

Dim Shared Anzahl As Long, DateiName As String

Sub Einlesen(Daten() As Real)
  Dim As Long 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 fr 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) As Real
    Daten(i)=Val(Zeile)
    i+=1
  Loop Until Eof(DateiNr)
  Close(DateiNr)
  Cls
  If i<2 Then
    Print "2 Meáwerte sind mindestens erforderlich, vorhanden sind " &i
    Print "Mehr messen..";
    GetKey
    End
  End If
  Anzahl=i
End Sub

Function Berechnen(Daten() As Real, Verbesserung() As Real, byRef mittlFehler As Real) As Real
  Dim As Long i
  Dim As Real Mittel, SummeVV
  For i=LBound(Daten) To Anzahl-1
    Mittel+=Daten(i)
  Next i 'esistnichtmehregalwashierstehtauchwenneszusammengeschreibenist
  Mittel/=Anzahl 'Mittelwert ausrechnen
  Redim Verbesserung(Anzahl) 'Da im Hauptprogramm bereits vereinbart, neu dimensionieren
  For i=LBound(Daten) To Anzahl-1
    Verbesserung(i)=Mittel-Daten(i)
    SummeVV+=Verbesserung(i)*Verbesserung(i) '^2 ginge auch, ist aber langsamer..
  Next
  If Anzahl>=MinMw Then mittlFehler=Sqr(SummeVV/(Anzahl-1)) 'mittl. Fehler berechnen
  Function=Mittel
End Function

Sub Ausgeben(Daten() As Real, Verbesserung() As Real, byVal MittelWert As Real, byVal mittlFehler As Real)
  Dim Mw As String="Mittelwert=", j As Long=Len(Mw), Rand As String=String(j, 32)
  Dim As Long i
  Dim As Real SummeV
  Print !"Einfaches arithmetisches Mittel ¸2007 by ytwinky, MD\n"
  Print "Auswertung der Datei " &DateiName &" mit " &Anzahl &" Meáwerten"
  Print Rand &"     Meáwert l     Verbesserung v  (Mittelwert=l+v)"
  For i=LBound(Daten) To Anzahl-1
    Print Rand;
    Print Using "########.#####"; Daten(i); Verbesserung(i)
    SummeV+=Verbesserung(i)
  Next
  Print Rand &"--------------"
  Print Mw;
  Print Using "########.#####"; MittelWert, SummeV
  Print Rand &!"==============\n"
  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 !"\n\nGenauigkeitsbetrachtung"
    Print "Mittl. Fehler der Einzelmessung=";
    Print Using "#.#####"; mittlFehler
    Print "Mittl. Fehler des Mittelwertes=";
    Print Using "#.#####"; mittlFehler/Sqr(Anzahl)
  End If
  GetKey
End Sub

'HauptProgramm
Einlesen(Daten()) 'Eingabe
Mittelwert=Berechnen(Daten(), Verbesserung(), mittlFehler) 'Verarbeitung
Ausgeben(Daten(), Verbesserung(), MittelWert, mittlFehler) 'Ausgabe
'Ende

Viel Spaß beim Auswerten :D
Gruß
ytwinky


Zusätzliche Informationen und Funktionen
  • Das Code-Beispiel wurde am 16.06.2007 von Redakteurytwinky angelegt.
  • Die aktuellste Version wurde am 20.08.2010 von Redakteurytwinky gespeichert.
  Bearbeiten Bearbeiten  

  Versionen Versionen