home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1991 / 07_08 / tricks / bestwert.mod < prev    next >
Encoding:
Text File  |  1991-03-20  |  8.8 KB  |  244 lines
  1. (* ------------------------------------------------------ *)
  2. (*                     BESTWERT.MOD                       *)
  3. (* Programm zur Ermittlung von Ausgleichskurven nach dem  *)
  4. (* Gaußschen Prinzip                                      *)
  5. (* Compiler: Fitted Modula-2 Version 2.0a                 *)
  6. (*          (c) 1991 Jens Rohloff & TOOLBOX               *)
  7. (* ------------------------------------------------------ *)
  8. MODULE Bestwertkurve;
  9.  
  10. IMPORT RealInOut;
  11.  
  12. FROM RealConversions IMPORT LongRealToString;
  13. FROM InOut           IMPORT WriteLine, WriteString,
  14.                             WriteCard, WriteLn, Read,
  15.                             ReadCard, Done;
  16. FROM Windows         IMPORT Window, OpenWindow, CloseWindow,
  17.                             SelectWindow;
  18. FROM Menu            IMPORT PopMenu;
  19. FROM Display         IMPORT SetCursorPosition, line0, col0,
  20.                             lineN, colN, ClrEOS;
  21. FROM Info            IMPORT Information;
  22.  
  23. CONST
  24.   max = 15;      (* Konstante für maximale Datenfeldgröße *)
  25.  
  26. TYPE
  27.   Daten = ARRAY [1..max] OF LONGREAL;     (* Datenfeldtyp *)
  28.  
  29. VAR
  30.   Xdaten, Ydaten : Daten;         (* Felder für die Daten *)
  31.   Titel, In, Aus : Window;        (* siehe Module Windows *)
  32.   Ende, Unsin    : BOOLEAN;       (* für Programmabbruch  *)
  33.   n, cmd         : CARDINAL;      (* zu cmd -> Module Menu*)
  34.   mwert, nwert   : LONGREAL;      (* Arbeitswerte         *)
  35.  
  36.  
  37.   PROCEDURE Einlesen(VAR Xdaten, Ydaten : Daten;
  38.                      VAR n              : CARDINAL);
  39.   (* Einlesen liest die X- und Y-Meßwerte sowie deren     *)
  40.   (* Anzahl ein.                                          *)
  41.   (* Xdaten: Datenfeld für die X-Werte der Meßreihe       *)
  42.   (* Ydaten: Datenfeld für die Y-Werte der Meßreihe       *)
  43.   (* n     : Anzahl der eingegebenen Wertepaare           *)
  44.   VAR
  45.     I : CARDINAL;
  46.   BEGIN
  47.     REPEAT
  48.       SetCursorPosition(line0, col0);       (* Oben links *)
  49.       ClrEOS;
  50.       WriteString(' Wie viele X-Y Werte ? (max.');
  51.       WriteCard(max, 2);
  52.       WriteString(' ) ');
  53.       ReadCard(n);
  54.     UNTIL(n <= max) AND Done;
  55.     SetCursorPosition(line0, col0);         (* Oben links *)
  56.     ClrEOS;
  57.     I := 1;
  58.     FOR I := 1 TO n DO
  59.       REPEAT
  60.         SetCursorPosition(line0+I-1, 2);
  61.         WriteCard(I, 2);
  62.         WriteString('.X-Wert eingeben : ');
  63.         RealInOut.ReadLongReal(Xdaten[I]);
  64.       UNTIL RealInOut.Done;
  65.       WriteString('  ');
  66.       REPEAT
  67.         SetCursorPosition(line0+I-1, 42);
  68.         WriteCard(I, 2);
  69.         WriteString('. Y-Wert eingeben : ');
  70.         RealInOut.ReadLongReal(Ydaten[I]);
  71.       UNTIL RealInOut.Done;
  72.     END;
  73.   END Einlesen;
  74.  
  75.  
  76.   PROCEDURE Amwert(VAR Xdaten, Ydaten : Daten;
  77.                        n              : CARDINAL;
  78.                    VAR Unsin          : BOOLEAN) : LONGREAL;
  79.   (* Amwert berechnet Formfaktor für 1.Fkt. Wenn die      *)
  80.   (* Anzahl der Datenpaare kleiner als zwei ist, bricht   *)
  81.   (* die Prozedur die Bearbeitung ab.                     *)
  82.   (* Xdaten: X-Werte der Meßreihe                         *)
  83.   (* Ydaten: Y-Werte der Meßreihe                         *)
  84.   (* n     : Anzahl der Wertepaare                        *)
  85.   (* Unsin : gibt TRUE zurück, wenn die Anzahl der Werte- *)
  86.   (*         paare nicht ausreicht                        *)
  87.   (* Amwert: Formfaktor für die Funktion f(x)= amwert * x *)
  88.   VAR
  89.     a               : CHAR;
  90.     I               : CARDINAL;
  91.     werta, wertb, m : LONGREAL;
  92.   BEGIN
  93.     werta := 0.0; wertb := 0.0; m := 0.0;
  94.     Unsin := (n < 2);                       (* Berechnung *)
  95.     IF NOT Unsin THEN
  96.       FOR I := 1 TO n DO
  97.         werta := werta + (Xdaten[I] * Ydaten[I]);
  98.         wertb := wertb + (Xdaten[I] * Xdaten[I]);
  99.       END;
  100.       m := (werta / wertb);
  101.     END;
  102.     RETURN(m);
  103.   END Amwert;
  104.  
  105.  
  106.   PROCEDURE Pwert(VAR Xdaten, Ydaten : Daten;
  107.                       n              : CARDINAL;
  108.                   VAR Unsin          : BOOLEAN) : LONGREAL;
  109.   (* Pwert berechnet Formfaktor für 3.Fkt. Wenn die       *)
  110.   (* Anzahl der Datenpaare kleiner als drei ist, bricht   *)
  111.   (* die Prozedur die Bearbeitung ab.                     *)
  112.   (* Xdaten: X-Werte der Meßreihe                         *)
  113.   (* Ydaten: Y-Werte der Meßreihe                         *)
  114.   (* n     : Anzahl der Wertepaare                        *)
  115.   (* Unsin : gibt TRUE zurück, wenn die Anzahl der Werte- *)
  116.   (*         paare nicht ausreicht                        *)
  117.   (* Pwert : Formfaktor für die Funktion f(x)= Pwert * x² *)
  118.   VAR
  119.     I               : CARDINAL;
  120.     a               : CHAR;
  121.     werta, wertb, P : LONGREAL;
  122.   BEGIN
  123.     werta := 0.0; wertb := 0.0; P := 0.0;
  124.     Unsin := (n < 3);
  125.     IF NOT Unsin THEN
  126.       FOR I := 1 TO n DO
  127.         werta := werta + (Ydaten[I]*Xdaten[I]*Xdaten[I]);
  128.         wertb := wertb + (Xdaten[I]*Xdaten[I]*
  129.                           Xdaten[I]*Xdaten[I]);
  130.       END;
  131.       P := (werta / wertb);
  132.     END;
  133.     RETURN(P);
  134.   END Pwert;
  135.  
  136.  
  137.   PROCEDURE mn(VAR Xdaten, Ydaten         : Daten;
  138.                    n                      : CARDINAL;
  139.                VAR AParameter, BParameter : LONGREAL;
  140.                VAR Unsin                  : BOOLEAN);
  141.   (* mn berechnet Formfaktore für 2.Fkt. Wenn die Anzahl  *)
  142.   (* der Datenpaare kleiner als zwei ist, bricht die      *)
  143.   (* Prozedur die Bearbeitung ab.                         *)
  144.   (* Xdaten: X-Werte der Meßreihe                         *)
  145.   (* Ydaten: Y-Werte der Meßreihe                         *)
  146.   (* n     : Anzahl der Wertepaare                        *)
  147.   (* Unsin : gibt TRUE zurück, wenn die Anzahl der Werte- *)
  148.   (*         paare nicht ausreicht                        *)
  149.   (* Aparameter: Werte für die Funktion in der Darstellung*)
  150.   (* Bparameter: f(x)=Aparameter * x + Bparameter         *)
  151.   VAR
  152.     I                                 : CARDINAL;
  153.     werta, wertb, wertc, wertd, werte : LONGREAL;
  154.   BEGIN
  155.     werta := 0.0; wertb := 0.0; wertc := 0.0;
  156.     wertd := 0.0; werte := 0.0;
  157.     AParameter := 0.0; BParameter := 0.0;
  158.     Unsin := (n < 3);
  159.     IF NOT Unsin THEN
  160.       FOR I := 1 TO n DO
  161.         werta := werta + (Xdaten[I] * Xdaten[I]);
  162.         wertb := wertb + (Xdaten[I]);
  163.         wertc := wertc + (Ydaten[I] * Xdaten[I]);
  164.         wertd := wertd + (1.0);
  165.         werte := werte + (Ydaten[I]);
  166.       END;
  167.       AParameter := ((wertc*wertd)-(wertb*werte)) /
  168.                     ((werta*wertd)-(wertb*wertb));
  169.       BParameter := ((werta*werte)-(wertb*wertc)) /
  170.                     ((werta*wertd)-(wertb*wertb));
  171.     END;
  172.   END mn;
  173.  
  174.  
  175.   PROCEDURE Ausgabe(awert, bwert : LONGREAL;
  176.                     Schalter     : CARDINAL);
  177.   (* Schalter = 1 => Ausgabefunktion f(x) = a1 * x        *)
  178.   (* Schalter = 2 => Ausgabefunktion f(x) = a1 * x + a0   *)
  179.   (* Schalter = 3 => Ausgabefunktion f(x) = a2 * x²       *)
  180.   VAR
  181.     antwort : CHAR;
  182.     string  : ARRAY [0..13] OF CHAR;
  183.     ok      : BOOLEAN;
  184.   BEGIN
  185.     SetCursorPosition(line0, 10);
  186.     WriteString('  Ermittelte Funktion : y = ');
  187.     LongRealToString(awert, 4, 13, string, ok);
  188.     IF ok THEN WriteString(string); END;
  189.     IF NOT (Schalter = 3) THEN
  190.                  (* Auswahl der richtigen Fkt-darstellung *)
  191.       WriteString(' * x ');
  192.       IF Schalter = 2 THEN
  193.         WriteString('+ ');
  194.         LongRealToString(bwert,4,13,string,ok);
  195.         IF ok THEN WriteString(string); END;
  196.       END;
  197.     ELSE
  198.       WriteString(' * x² ');
  199.     END;
  200.     Read(antwort);     (* Warten auf Aktion des Anwenders *)
  201.     SetCursorPosition(lineN, colN);
  202.   END Ausgabe;
  203.  
  204. BEGIN
  205.   SetCursorPosition(line0, col0);
  206.   OpenWindow(Titel, 0, 0, 3, 79, TRUE,
  207.              ('[ Bestwertkurvengenerator ]'));
  208.   Ende := FALSE;
  209.   REPEAT
  210.   PopMenu(4, 0, "[ Auswahl ]|Form : y=m*x|Form : " +
  211.                 "y=m*x+n|Form : y=p*x²|Information |Ende",
  212.           20, TRUE, cmd);
  213.     IF NOT ((cmd = 4) OR (cmd = 5)) THEN
  214.       OpenWindow(In,   4, 0, 20, 79, TRUE, ('[ Eingabe ]'));
  215.       OpenWindow(Aus, 21, 0, 24, 79, TRUE, ('[ Ausgabe ]'));
  216.       SelectWindow(In, FALSE);
  217.       Einlesen(Xdaten, Ydaten, n);
  218.       SelectWindow(Aus, FALSE);
  219.       CASE cmd OF
  220.         1:  mwert := Amwert(Xdaten, Ydaten, n, Unsin);
  221.             IF NOT Unsin THEN Ausgabe(mwert, 0.0, 1) END
  222.       |
  223.         2:  mn(Xdaten, Ydaten, n, mwert, nwert, Unsin);
  224.             IF NOT Unsin THEN Ausgabe(mwert, nwert, 2) END
  225.       |
  226.         3:  mwert := Pwert(Xdaten, Ydaten, n, Unsin);
  227.             IF NOT Unsin THEN Ausgabe(mwert, 0.0, 3) END;
  228.       END;
  229.       CloseWindow(Aus);
  230.       CloseWindow(In);
  231.     ELSE
  232.       CASE cmd OF
  233.         4: Information('Bestwert.doc');
  234.                                    (* Datei mit Hilfetext *)
  235.       ELSE
  236.         Ende := TRUE
  237.       END;
  238.     END;
  239.   UNTIL Ende;
  240.   CloseWindow(Titel);
  241. END Bestwertkurve.
  242. (* ------------------------------------------------------ *)
  243. (*                 Ende von BESTWERT.MOD                  *)
  244.