Guest User

Untitled

a guest
Dec 23rd, 2018
166
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1.    ----------------------------------------------------------------------------
  2.    --  Natural_Logarithm
  3.  
  4.    --  Implementation Notes:
  5.    --    - Let f = (x - 1) / (x + 1).
  6.    --    - Uses series
  7.    --        ln (x) = 2 * (f + f**3 / 3 + f**5 / 5 + ...) when 1/2 < x < 2,
  8.    --        ln (x) = 2 * ln (sqrt (x)) otherwise.
  9.    function Natural_Logarithm (X : Decimal) return Decimal is
  10.  
  11.       A : Decimal := X;
  12.       L : Decimal;
  13.       P : Decimal := To_Number (2);
  14.  
  15.       Old_Model : constant Rounding_Model := Get_Rounding;
  16.  
  17.    begin  --  Natural_Logarithm
  18.  
  19.       if A <= To_Number (0) then
  20.          raise Non_Existent_Logarithm;
  21.       end if;
  22.  
  23.       Set_Rounding
  24.         (Scale  => Get_Scale (Old_Model) + 6,
  25.          Method => Truncate);
  26.  
  27.       Normalize : declare
  28.  
  29.          Two  : constant Decimal := To_Number (2);
  30.          Half : constant Decimal := To_Number ("0.5");
  31.          S    :          Natural := 0;
  32.  
  33.       begin
  34.  
  35.          while A >= Two or else A <= Half loop
  36.             A := Root (A, Two);
  37.             P := P * Two;
  38.             S := S + 1;
  39.          end loop;
  40.  
  41.          Set_Scale (Get_Scale + S);
  42.  
  43.       end Normalize;
  44.  
  45.       Computation : declare
  46.  
  47.          F :          Decimal := (A - To_Number (1)) / (A + To_Number (1));
  48.          M : constant Decimal := F * F;
  49.          N :          Decimal := To_Number (3);
  50.          S :          Decimal;
  51.  
  52.       begin
  53.  
  54.          L := F;
  55.  
  56.          loop
  57.             F := F * M;
  58.             S := F / N;
  59.             exit when S = To_Number (0);
  60.             L := L + S;
  61.             N := N + To_Number (2);
  62.          end loop;
  63.  
  64.       end Computation;
  65.  
  66.       Denormalize : begin
  67.  
  68.          L := L * P;
  69.  
  70.       end Denormalize;
  71.  
  72.       Round
  73.         (Self  => L,
  74.          Model => New_Model
  75.            (Scale  => Get_Scale (Old_Model),
  76.             Method => Truncate));
  77.  
  78.       Set_Rounding (Old_Model);
  79.  
  80.       return L;
  81.  
  82.    end Natural_Logarithm;
RAW Paste Data