Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!fb:porticula NoPaste
Allgemeines arithmetisches Mittel
| Uploader: |  ytwinky |
| Datum/Zeit: | 03.07.2007 21:56:03 |
'Ä=Ž , Ö=™ , Ü=š ; ä=„ , ö=”, ü= , ß=á ,§=õ , ©=¸ ,°=ø
#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 Long, DateiName As String
Sub Einlesen(Daten() As Beobachtung)
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
?"Fehler beim Öffnen der Datei, Programmende"
Sleep
End
Else
?"Datei " &DateiName &" existiert nicht!"
Input "Neuer Dateiname(Enter beendet):", DateiName
If DateiName="" Then End
End If
End If
Loop Until OpenErr=0
?"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
?MinMw &" Meáwerte sind mindestens erforderlich, vorhanden sind " &i
?"Mehr messen.."
Sleep
End
End If
Anzahl=i
End Sub
Function Berechnen(Daten() As Beobachtung, byRef SummeP As Real, byRef m0 As Real) As Real
Dim As Long 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 esistegalwashierstehtesmussnurzusammengeschreibensein
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 Long=Len(Mw), Rand As String=String(j, 32)
Dim As Long i
Dim As Real SummeV
?"Allgemeines arithmetisches Mittel ¸2007 by ytwinky, MD"
?"Auswertung der Datei " &DateiName &" mit " &Anzahl &" Meáwerten"
?Rand &" Meáwert l Gewicht p Verbesserung v Mittl. Fehler"
For i=LBound(Daten) To Anzahl-1
?Rand;
With Daten(i)
?Using "########.#####"; .Messwert; .Gewicht; .Verbesserung; m0/Sqr(.Gewicht)
SummeV+=.Verbesserung
End With
Next
?Rand &"--------------"
?Mw;
?Using "########.#####"; MittelWert;
?String(14, 32);
?Using "########.#####"; SummeV
?Rand &"=============="
?"Summe der Verbesserungen muá=0 sein(oder ganz dicht dabei)"
?"(Für jede Meáwertzeile gilt: Mittelwert=Meáwert+Verbesserung)"
If Anzahl>MinMw Then
?
?"Genauigkeitsbetrachtung"
?"m0=";
?Using "#.#####"; m0
?"Mittl. Fehler des gewichteten Mittelwertes=";
?Using "#.#####"; m0/Sqr(SummeP);
End If
Sleep
End Sub
'HauptProgramm
Einlesen(Daten()) 'Eingabe
Mittelwert=Berechnen(Daten(), SummeP, m0) 'Verarbeitung
Ausgeben(Daten(), MittelWert, SummeP, m0) 'Ausgabe
'Ende