home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / modula2 / library / fst / modula3 / funktion.mod < prev    next >
Text File  |  1993-07-28  |  7KB  |  232 lines
  1. MODULE funktion;
  2. (*******************************************************************
  3.    Berechnung der Maximal- und Minimalwerte folgender Functionen:
  4.    a) f(x,y) := sin(2.0*x)+sin(3.0*y)+cos(4.0*x)+cos(5.0*y)
  5.    b) f(x,y) := exp(x+y/2.0)*cos(x*y)
  6.    c) f(x,y) := x*y
  7.    d) f(x,y) := sin(x+y)*cos(x*y)
  8.    e) f(x,y) := exp(x)*cos(x*y)-sin(2.0*x)+cos(6.0*y).
  9.    Die Grenzen ([a,b] x [c,d]) müßen explizit eingegeben werden.
  10.  
  11.  
  12.  *******************************************************************)
  13. FROM InOut     IMPORT WriteLn,
  14.                       WriteString,
  15.                       ReadCard,
  16.                       WriteCard,
  17.                       Read,
  18.                       Write;
  19. FROM MathLib0  IMPORT sin,
  20.                       cos,
  21.                       exp;
  22. FROM RealInOut IMPORT WriteReal,
  23.                       ReadReal,
  24.                       Done;
  25. FROM Strings   IMPORT Assign;
  26.  
  27. TYPE
  28.    Function = PROCEDURE(REAL, REAL) : REAL;
  29.    String70 = ARRAY[1..70] OF CHAR;
  30.  
  31. CONST
  32.   Anzfunk = 5;
  33.  
  34. VAR
  35.   funkname : ARRAY[1..Anzfunk] OF String70;
  36.   f : Function;
  37.   a, b, delta1, (* Intervall [a,b] und die zugehoerige Schrittweite *)
  38.   c, d, delta2  (* Intervall [c,d] und die zugehoerige Schrittweite *)
  39.   : REAL;
  40.   wahl : CARDINAL; (* Laufvariable *)
  41.  
  42.  
  43. (*******************************************************************)
  44. (* Procedure INIT                                                  *)
  45. (*******************************************************************)
  46. (* Setzt alle Variablen auf 0.0 und weist dem Feld funkname die    *)
  47. (* Bezeichnungen der einzelnen Funktionen zu.                      *)
  48. (* Abschliessend wird eine Nachricht ausgegeben.                   *)
  49. (*******************************************************************)
  50. PROCEDURE init;
  51. VAR
  52.   j : CARDINAL;
  53.  
  54. BEGIN
  55.   a:=0.0; b:=0.0; c:=0.0; d:=0.0; delta1:=0.0; delta2:=0.0;
  56.  
  57.   Assign('f(x,y) := sin(2.0*x)+sin(3.0*y)+cos(4.0*x)+cos(5.0*y)',
  58.          funkname[1]);
  59.   Assign('f(x,y) := exp(x+y/2.0)*cos(x*y)', funkname[2]);
  60.   Assign('f(x,y) := x*y', funkname[3]);
  61.   Assign('f(x,y) := sin(x+y)*cos(x*y)', funkname[4]);
  62.   Assign('f(x,y) := exp(x)*cos(x*y)-sin(2.0*x)+cos(6.0*y)',
  63.          funkname[5]);
  64.   WriteLn; WriteLn;
  65.   WriteString('Dieses Programm berechnet die Minimal- bzw.');
  66.   WriteString(' Maximalwerte der folgenden'); WriteLn;
  67.   WriteString('Funktionen im Intervall [a,b] x [c,d]'); WriteLn;
  68.   WriteString('Zur Auswahl stehen: '); WriteLn;
  69.   WriteLn;
  70.   FOR j:=1 TO Anzfunk DO
  71.     WriteCard(j, 0); WriteString(': ');
  72.     WriteString(funkname[j]); WriteLn;
  73.   END;
  74. END init;
  75.  
  76.  
  77.  
  78. (*******************************************************************)
  79. (* Procedure f1, f2, f3, f4 und f5                                 *)
  80. (*******************************************************************)
  81. (* Diese Prozeduren enthalten die zur Asuwahl stehenden Funktionen.*)
  82. (*******************************************************************)
  83. PROCEDURE f1(x, y : REAL) : REAL;
  84. BEGIN
  85.   RETURN sin(2.0*x)+sin(3.0*y)+cos(4.0*x)+cos(5.0*y);
  86. END f1;
  87.  
  88. PROCEDURE f2(x, y : REAL) : REAL;
  89. BEGIN
  90.   RETURN exp(x+y/2.0)*cos(x*y);
  91. END f2;
  92.  
  93. PROCEDURE f3(x, y : REAL) : REAL;
  94. BEGIN
  95.   RETURN x*y;
  96. END f3;
  97.  
  98. PROCEDURE f4(x, y : REAL) : REAL;
  99. BEGIN
  100.   RETURN sin(x+y)*cos(x*y);
  101. END f4;
  102.  
  103. PROCEDURE f5(x, y : REAL) : REAL;
  104. BEGIN
  105.   RETURN exp(x)*cos(x*y)-sin(2.0*x)+cos(6.0*y);
  106. END f5;
  107.  
  108.  
  109.  
  110. (*******************************************************************)
  111. (* Procedure MINMAX                                                *)
  112. (*******************************************************************)
  113. (* Berechnet den Minimal- bzw. Maximalwert der Funktion f im       *)
  114. (* Intervall [a,b] x [c,d] und gibt das Ergebnis aus.              *)
  115. (*******************************************************************)
  116. PROCEDURE minmax(f : Function;
  117.                  a, b, delta1, c, d, delta2 : REAL);
  118. VAR
  119.   min, max,       (* Minimum bzw. Maximum *)
  120.   x, y, z : REAL; (* Laufvariablen *)
  121.  
  122. BEGIN
  123.   min:=f(a, c);                            (* Startwert min *)
  124.   max:=min;                                (* Startwert max *)
  125.   x:=a;
  126.   y:=c;
  127.   WHILE (x<=b) DO                          (* berechnen *)
  128.     WHILE (y<=d) DO
  129.       z:=f(x, y);
  130.       IF (z<min) THEN min:=z; END;
  131.       IF (z>max) THEN max:=z; END;
  132.       y:=y+delta2;
  133.     END;
  134.     x:=x+delta1;
  135.   END;
  136.   WriteLn;                                 (* und ausgeben *)
  137.   WriteString('Das Minimum betraegt: ');
  138.   WriteReal(min, 10); WriteLn;
  139.   WriteString('Das Maximum betraegt: ');
  140.   WriteReal(max, 10); WriteLn;
  141. END minmax;
  142.  
  143.  
  144. (*******************************************************************)
  145. (* Procedure LESEREAL                                              *)
  146. (*******************************************************************)
  147. (* Gibt die Nachricht m aus und liest eine REAL-Zahl ein.          *)
  148. (*******************************************************************)
  149. PROCEDURE lesereal(m : ARRAY OF CHAR) : REAL;
  150. VAR
  151.   z : REAL;
  152.  
  153. BEGIN
  154.   REPEAT
  155.     WriteString(m);
  156.     ReadReal(z); WriteLn;
  157.   UNTIL Done;
  158.   RETURN z;
  159. END lesereal;
  160.  
  161.  
  162. (*******************************************************************)
  163. (* Procedure LESEPOSREAL                                           *)
  164. (*******************************************************************)
  165. (* gibt die Nachricht m aus und liest eine positive REAL-Zahl ein. *)
  166. (*******************************************************************)
  167. PROCEDURE leseposreal(m : ARRAY OF CHAR) : REAL;
  168. VAR
  169.   z : REAL;
  170.  
  171. BEGIN
  172.   REPEAT
  173.     WriteString(m);
  174.     ReadReal(z); WriteLn;
  175.   UNTIL (z>0.0);
  176.   RETURN z;
  177. END leseposreal;
  178.  
  179.  
  180. (*******************************************************************)
  181. (* Hauptprogramm                                                   *)
  182. (*******************************************************************)
  183. BEGIN
  184.   init;
  185.   (* Funktion auswaehlen *)
  186.   WriteLn;
  187.   REPEAT
  188.     WriteString('Bitte waehlen Sie ein Funktion aus: ');
  189.     ReadCard(wahl); WriteLn;
  190.   UNTIL (wahl>=1) AND (wahl<=Anzfunk);
  191.   WriteLn;
  192.   WriteCard(wahl, 0); WriteString(': ');
  193.   WriteString(funkname[wahl]); WriteLn;
  194.  
  195.   CASE wahl OF
  196.     1 : f:=f1; |
  197.     2 : f:=f2; |
  198.     3 : f:=f3; |
  199.     4 : f:=f4; |
  200.     5 : f:=f5; |
  201.   END;
  202.   WriteLn;
  203.  
  204.   (* Intervall [a,b] einlesen *)
  205.   WriteString('Bitte Intervall [a;b] eingeben (a<b):');
  206.   WriteLn;
  207.   REPEAT
  208.     a:=lesereal('Bitte a eingeben (Realzahl): ');
  209.     b:=lesereal('Bitte b eingeben (Realzahl): ');
  210.   UNTIL (a<b);
  211.   delta1:=leseposreal('Bitte Schrittweite (Realzahl und >0) eingeben: ');
  212.   WriteLn;
  213.  
  214.   (* Intervall [c,d] einlesen *)
  215.   WriteString('Bitte Intervall [c;d] eingeben (c<d):');
  216.   WriteLn;
  217.   REPEAT
  218.     c:=lesereal('Bitte c eingeben (Realzahl): ');
  219.     d:=lesereal('Bitte d eingeben (Realzahl): ');
  220.   UNTIL (c<d);
  221.   delta2:=leseposreal('Bitte Schrittweite (Realzahl und >0) eingeben: ');
  222.  
  223.   minmax(f, a, b, delta1, c, d, delta2);     (* Berechnung *)
  224.  
  225.   WriteLn;
  226.   WriteString('Ende der Berechnung.');
  227.   WriteLn; WriteLn;
  228. END funktion.
  229.  
  230.  
  231.  
  232.