All pastes #749640 Raw Edit

rel_fehler

public text v1 · immutable
#749640 ·published 2007-10-25 20:39 UTC
rendered paste body
--  FILE:       rel_fehler.adb

with Ada.Numerics.Elementary_Functions;
use Ada.Numerics.Elementary_Functions;

with Ada.Text_IO;
use Ada.Text_IO;

with Ada.Integer_Text_IO;
use Ada.Integer_Text_IO;

with Ada.Float_Text_IO;
use Ada.Float_Text_IO;


procedure Rel_Fehler is

   type Type_X_Null is array (1 .. 4) of Float;
   type Type_Result_Taylor is array (1 .. 20) of Float;
   type Type_Array_Result_Taylor is array (1 .. 4) of Type_Result_Taylor;

   X_Null              : Type_X_Null := (-10.0, -1.0, 1.0, 10.0);
   Result_Exp          : Float;
   Array_Result_Taylor : Type_Array_Result_Taylor;
   X_Wert              : Float;

   --  FUNCTION Fehler
   function Fehler (
         Exp    : Float;
         Taylor : Float)
     return Float
   is
   begin
      return (abs (Exp - Taylor) / Exp);
   end Fehler;

   --  FUNCTION Fak
   function Fak (
            N : Integer)
      return Long_Long_Integer
   is
      function Fak2 (
               N : Long_Long_Integer)
        return Long_Long_Integer is
      begin
         if N = 1 then
            return 1;
         else
            --  Put (" " & Long_Long_Integer'Image (N * Fak2 (N - 1)) & " ");
            return N * Fak2 (N - 1);
         end if;
      end Fak2;
   begin
      case N is
         when 1 | 0 => return 1;
         when 2 => return 2;
         when 3 => return 6;
         when 4 => return 24;
         when 5 => return 120;
         when 6 => return 720;
         when 7 => return 5040;
         when 8 => return 40320;
         when 9 => return 362880;
         when 10 => return 3628800;
         when 11 => return 39916800;
         when 12 => return 479001600;
         when 13 => return 6227020800;
         when 14 => return 87178291200;
         when 15 => return 1307674368000;
         when 16 => return 20922789888000;
         when 17 => return 355687428096000;
         when 18 => return 6402373705728000;
         when 19 => return 121645100408832000;
         when 20 => return 2432902008176640000;
         when others => return Fak2 (Long_Long_Integer (N));
      end case;
   end Fak;
   --  FUNCTION FakF
   --
   --  Returns the Factorial as Float
   function FakF (
            N : Integer)
      return Float
   is
   begin
      return Float (Fak (N));
   end FakF;

   --  FUNCTION Taylor
   function Taylor (
         Index_X_Null : Integer;
         Glieder      : Integer)
     return Float
   is
      X_0 : Float := X_Null (Index_X_Null);

      type Type_Array_T is array (0 .. 20) of Float;
      T : Type_Array_T;
   begin
      T (0) := Exp (X_0);
      for i in 1 .. 20 loop
         T (i) := T (i - 1) +
            ( (   (  ( X_Wert/abs(X_Wert) )**I  ) * (Exp(X_0)) / (FakF (I)) )
                * (X_Wert - X_0) **i);
      end loop;
      return T (Glieder);
   end Taylor;

begin

   Put_Line ("Geben Sie einen X_Wert ein: ");
   Get (X_Wert);

   Result_Exp := Exp (X_Wert);

   for I in 1 .. 4 loop
      for J in 1 .. 20 loop
         Array_Result_Taylor (I) (J) := (Taylor (I, J));
      end loop;
   end loop;

   Put ("Ergebnis fuer die Berechnung mit e**x: ");
   Put (Result_Exp, 3,30,0);
   New_Line;
   Put_Line ("-------------------------------------------------------");

   Put_Line ("Ergebnisse fuer die Berechnung mit Taylor: ");
   Put_Line ("-------------------------------------------------------");
   for I in 1 .. 4 loop
      for J in 1 .. 20 loop
         Put ("Result_Taylor fuer X_NULL=");
         Put (X_Null (I), 3, 0, 0);
         Put (", n=");
         Put (J, 3);
         Put ("ist: ");

         Put (Array_Result_Taylor (I) (J), 3, 30, 0);
         New_Line;
      end loop;
   end loop;

   Put_Line ("-------------------------------------------------------");
   Put ("Der relative Fehler ist: ");
   New_Line;

   for I in 1 .. 4 loop
      for J in 1 .. 20 loop
         Put ("Fehler fuer X_NULL=");
         Put (X_Null (I), 3, 0, 0);
         Put (", n=");
         Put (J, 3);
         Put ("ist: ");

         Put (Fehler (Result_Exp, Array_Result_Taylor (I) (J)), 3, 30, 0);
         New_Line;
      end loop;
   end loop;

end Rel_Fehler;