Turbo Toolbox/Turbo_Toolbox.iso/spezial/15/graphen/infini.pas

Pascal/Delphi Source File | 1989-05-19 | 7.7 KB | 214 lines

PROGRAM InfinitisimalRechnung;

{ Dieses Programm berechnet numerisch die 1. und 2. Ableitung einer Funktion  }
{ sowie deren Stammfunktion (Integralrechnung)                                }
{ Die berechneten Daten werden in die Datei INFI.DAT eingeschrieben und kön-  }
{ nen dann mit Hilfe des Programm's GRAPHEN ausgewertet werden.               }
{                                                                             }
{ --------------------------------------------------------------------------- }
{               - Sprache     :  TURBO PASCAL 4.0 / 3.0 -                     }
{               - Copyright  (c) 1989  Heinz Hagemeyer  -                     }
{                       - & TOOLBOX International -                           }
{                                                                             }
{ --------------------------------------------------------------------------- }

USES CRT;   (* bei TURBO - PASCAL 4.0 *)

CONST   tab = 20      ;     { Tabulator             }

TYPE  Zeile = String [80];

VAR infini  : Text    ;     { Datei                 }
    i       : Integer ;     { Laufvariable          }
    x,                      { unabhaengige Variable }
    y,                      { abhaengige      "     }
    xa,xe,                  { Anfangs / Endwert     }
    sw,                     { Schrittweite          }
    Sum,                    { Aufsummierte Werte    }
    ic      : Real    ;     { Integrationskonst.    }
    fw,                     { Funktionswerte        }
    a1,                     { 1. Ableitung          }
    a2,                     { 2. Ableitung          }
    integral: Boolean ;     { Stammfunktion         }

{ --------------------------------------------------------------------------- }

FUNCTION JA_NEIN : Boolean;

{ Liefert TRU zurueck, wenn die Taste J gedrueckt wurde, sonst FALSE          }
{ --       fuer Turbo 4.0 muss folgendes geaendert werden :                -- }
{ --       c := Upcase (ReadKey) ;                                         -- }

VAR c : Char;
BEGIN
     REPEAT
{          Read (kbd,c);                 Diese Zeilen bei TURBO 3.0 einfügen  }
{          c := UpCase (c);                                                   }
           c := Upcase (ReadKey);       { und diese löschen oder einklammern  }
     UNTIL (c='J') OR (c='N');
     WriteLn (c);
     JA_NEIN := c = 'J';
END;

{ --------------------------------------------------------------------------- }

PROCEDURE Anfangswerte (VAR xa,xe,sw,c : Real; VAR fw,a1,a2,integral : Boolean);
BEGIN
     ClrScr;
     WriteLn ('INFINI, ein Programm zur Berechnung einer Funktion, deren');
     WriteLn ('     Ableitungen und deren Stammfunktion (Integral)');
     WriteLn;
     Write   ('Startwert ........ : '); ReadLn (xa);
     Write   ('Endwert .......... : '); ReadLn (xe);
     Write   ('Schrittweite ..... : '); readLn (sw);
     WriteLn;
     WriteLn ('Welche Funktionen wollen Sie berechnen lassen : ');
     WriteLn ('Bitte nur J/N eingeben');
     WriteLn;
     Write   ('Funktionswerte tabellieren .. : '); fw       := JA_NEIN;
     Write   ('1. Ableitung        "      .. : '); a1       := JA_NEIN;
     Write   ('2. Ableitung        "      .. : '); a2       := JA_NEIN;
     Write   ('Stammfunktion       "      .. : '); integral := JA_NEIN;

     IF Integral THEN
     BEGIN
          WriteLn;
          Write   ('Anfangswert (Integrationskonstante) : ');
          ReadLn  (c);
     END;
     WriteLn;
END;

{ --------------------------------------------------------------------------- }

PROCEDURE Tabellenkopf (t : Zeile);
VAR i : Integer;
BEGIN
     WriteLn;
     WriteLn  (t);
     WriteLn;
     WriteLn  ('x':tab,'y':tab);
     For i := 1 to 2*tab DO Write ('=');
     WriteLn;
END;

{ --------------------------------------------------------------------------- }
{         schreibt die berechneten daten in die Datei ein                     }

PROCEDURE Schreibe_in_Datei (VAR t : Text; x,y : Real);

CONST Klingel = #07;

BEGIN
     {$I-}                     { Fehlerueberwachung aus }
          WriteLn (t,x,' ',y );
     {$I+}                     { und wieder ein         }

     IF IOResult <> 0 THEN
     BEGIN
          GotoXY (1,1);
          Write  (Klingel,'Diskette voll, Programm wird abgebrochen !');
          Close (t);
          HALT;
     END;
END;

{ --------------------------------------------------------------------------- }
{ Schreibt die berechneten Daten in die Datei ein und gibt sie auf dem Bild-  }
{ schirm aus.                                                                 }

PROCEDURE Schreibe (VAR t : Text; x,y : Real);
BEGIN
     Schreibe_in_Datei (t,x,y);
     WriteLn (x:tab,y:tab)  ;
END;

{ --------------------------------------------------------------------------- }
{ Berechnet die Funktionswerte sowie deren 1. und 2. Ableitung nach Tayler in }
{ Abhaengigkeit von n                                                         }

FUNCTION F (n : integer; x : Real ) : Real;

CONST h = 0.0001;     { Von dieser Konstanten ist die Genauigkeit der Rech-   }
                      { nung abhaengig. Sie darf aber nicht zu klein gewaehlt }
                      { werden, weil durch Rundungsfehler sonst die Gefahr    }
                      { besteht, durch Null zu dividieren.                    }

FUNCTION Y (x : Real ) : Real ;

{ Hier muss die eigentliche Funktion editiert werden. Gegebenenfalls CALC    }
{ (Spezialdiskette IV  Calc & Kurvendiskussion) einsetzen                    }

BEGIN
     Y :=  x*x;
END;

BEGIN { Function f }

     CASE n OF
            0 : F := Y(x);
            1 : F := (Y (x + h) - Y (x - h) )/ 2 / h ;
            2 : F := (Y (x + h + h) - 2 * Y (x)
                     + Y (x - h - h) ) / 4 / Sqr (h) ;
     ELSE
        BEGIN
             WriteLn ('Fehler in F(x) , Fragen Sie den Programmierer');
             HALT
        END;
     END { CASE } ;
END;

{ -------------------------------------------------------------------------- }
{ diese Procedure gibt den Tabellenkopf aus und berechnet dann je nach n die }
{ Ableitungen bzw. die Funktion.                                             }

PROCEDURE Berechne (t : Zeile ; n : Integer);
BEGIN
    Tabellenkopf (t);

    FOR i := 0 to Round ((xe - xa) / sw) DO
    BEGIN
         x := xa + sw * i;
         y := F(n,x);
         Schreibe (infini,x,y);
     END;
     WriteLn (infini);
END;

{ -------------------------------------------------------------------------- }

BEGIN    { Main }

     Assign  (infini,'infi.dat');     { Vorbereitung der Dateien         }
     Rewrite (infini);                { Oeffne Datei zum Schreiben       }

     Anfangswerte (xa,xe,sw,ic,
                   Fw,a1,a2,integral);

     IF Fw THEN  Berechne ('Funktionswerte :',0);
     IF a1 THEN  Berechne ('1. Ableitung :',  1);
     IF a2 THEN  Berechne ('2. Ableitung :',  2);

     { Die Integration erfolg nach der Doppelstreifenregel. Diese ist bis zu }
     { Funktionen 3. Grades exakt ! (von Rundungsfehlern abgesehen)          }

     IF Integral THEN
     BEGIN
          Tabellenkopf ('Integration :');

          x := xa;                    { Anfanswert = Integrationskonstante  }
          y := ic;
          Schreibe (infini,x,y);

          FOR i := 1 to Round ((xe - xa) / sw) DO
          BEGIN
               x := xa + sw * i;
               y := y + sw * ( F(0,x) + 4*F(0,x+sw/2) + F(0,x+sw) ) / 6;
               Schreibe (infini,x,y);
          END;
     END;
     Close (infini);
END.
{ --------------------------------------------------------------------------- }
{ --                       Ende von INFI.PAS                               -- }