create or replace package sqlru_pwr is

-- применения процедуры возведения в степень
----------------------------

-- возводим в степень способом русских крестьян (алгоритм Ахмеса)
-- cdterms_test_dbr.Power
Function Power( px in number
              , pn In Pls_integer -- целая степень
              ) Return Number Deterministic Parallel_Enable;
----------------------------

-- дублировние строки pc_valx в количестве pn раз на бюазе возведения в степень
Function Replicate(pc_valx in Varchar2, pn In Pls_integer -- количестов дублирований (степень)
                  ) return Varchar2 Deterministic Parallel_Enable;       
----------------------------

-- вычисление чисел Фибоначчи на парах по Степанову. 
Function dkas_fib_p(pn In Number -- номер числа
                 ) Return Number Deterministic Parallel_Enable;
----------------------------

-- вычисление чисел Фибоначчи на парах по Степанову. (Возведение пар в степень)
-- follow Donald Knuth & Alex Stepanov ( see Sean Parent demonstration for full matrix version)
-- 193 - номер последнего числа, которое может быть правильно вычислено в PL/SQL (=9663391306290450775010025392525829059713).
-- 9999999999999999999999999999999999999999 - число до которого работает без ошибок целочисленная арифметика в PL/SQL
-- 193-е число Фибоначчи - самое большое, не превышающее этого значения.
Function dkas_fib_p(pn In Number -- номер числа
                 ) Return Number Deterministic Parallel_Enable;

End sqlru_pwr;
/
create or replace package body sqlru_pwr
-------------------------------------------------------------------------------------
-- для варианта вычисления чисел Фибоначчи на парах по Степанову
TYPE T_FIB_PARE is record(m0 Number, m1 Number);
--------------------------------------------------------------------------------------

-- единица для чисел по умножению
Function mlt_Identity_Element(pv_type in Number) return number 
  Is
Begin
  Return 1.0;
End;
------------------------

-- единица для пары Степанова, производящей числа Фибоначчи
Function mlt_Identity_Element(pv_type in T_FIB_PARE) return T_FIB_PARE Deterministic
  Is
  cmtx_fib_identity  T_FIB_PARE;
Begin
  cmtx_fib_identity.m0 := 0;
  cmtx_fib_identity.m1 := 1;
  Return cmtx_fib_identity;
End;   
------------------------

-- единица для строк по конкатенации
Function mlt_Identity_Element(pv_type in Varchar2) return Varchar2 Deterministic
  Is
Begin
  Return '';
End;
------------------------

-- операция крестьянского алгоритма для чисел по умножению
Function mult_op(x in Number, y in Number) return Number deterministic
  is
Begin
  Return x*y;
End;    
------------------------

-- операция крестьянского алгоритма для строк по конкатенации
Function mult_op(x in Varchar2, y in Varchar2) return Varchar2 deterministic
  is
Begin
  Return x||y;
End;  
------------------------  

-- операция крестьянского алгоритма  для "Фибоначевой пары" по умножению
Function mult_op(x in T_FIB_PARE, y in T_FIB_PARE) Return T_FIB_PARE
Is 
  r_result T_FIB_PARE;
Begin
  -- followed by Alex Stepanov
  r_result.m0 := x.m0 * (y.m1 + y.m0) + x.m1 * y.m0;
  r_result.m1 := x.m0 * y.m0 + x.m1 * y.m1;
  Return r_result;
End;
------------------------

-- Определение нечетного числа - для нечетного числа возвратим 1
Function Odd_i(iparam In Pls_Integer ) return pls_integer Deterministic Parallel_Enable
Is
    ci_One constant Pls_integer := 1;
Begin
    Return Bitand(iparam,ci_One);
End;   
--------------------------

-- целочисленная половина (для уменьшения степени вдвое на шаге крестьянского алгоритма)
Function Half(iparam In Pls_Integer ) Return Pls_integer 
is
Begin
  -- ограничимся положительными значенями, иначе бы потребовался печальный Trunc
  Return Floor(iparam/2); 
End;    
------------------------

-- возводим в степень способом русских крестьян (алгоритм Ахмеса)
-- (для чисел - как демонстрация и для проверки правильности работы алгоритма.)
-- версии для других типов данных образуются из этой путем копирования и замены типов входных параметров 
-- и им соответствующих локальных переменных.
-- follow Alex Stepanov
Function Power_rpa( px in number
              , pn In Pls_integer -- целая степень
              ) return number Deterministic Parallel_Enable
Is
  
  degree Pls_integer;
  x_lc Number;
  mresult Number;
Begin
  PRAGMA INLINE(mlt_Identity_Element,'YES');
  If pn = 0 Then return mlt_Identity_Element(px); End If;
  degree := pn; 
  x_lc := px;
  PRAGMA INLINE(Odd_i,'YES');
  While Odd_i(degree) = 0 
  Loop
    PRAGMA INLINE(Half,'YES');
    degree := Half(degree);
    
    PRAGMA INLINE(mult_op,'YES');
    x_lc := mult_op(x_lc, x_lc);
  End Loop; 
  mresult := x_lc;
  
  PRAGMA INLINE(Half,'YES');
  degree := Half(degree);
  
  While degree != 0
  Loop
    x_lc := mult_op(x_lc, x_lc);
    PRAGMA INLINE(Odd_i,'YES');
    If Odd_i(degree) != 0
      Then
        PRAGMA INLINE(mult_op,'YES');        
        mresult := mult_op(mresult, x_lc);
    End If;
    PRAGMA INLINE(Half,'YES');
    degree := Half(degree);
  End Loop;
  Return mresult; 
End;                
------------------------

-- возведение в степень (дублирование) строки
-- (аналог replicate или repeat в "других языках", в интерфейсе пакета публикуется как Replicate)
-- copy-past версии для чисел с заменой типов параметра, результата и локальных переменных
-- (возведение в степень способом русских крестьян (алгоритм Ахмеса))
Function Power_rpa( px in Varchar2
              , pn In Pls_integer -- целая степень
              ) return Varchar2 Deterministic Parallel_Enable
Is
  SUBTYPE T_MAXSTRING IS Varchar2(32767);
  degree Pls_integer;
  x_lc T_MAXSTRING;
  mresult T_MAXSTRING;
Begin
  PRAGMA INLINE(mlt_Identity_Element,'YES');
  If pn = 0 Then return mlt_Identity_Element(px); End If;
  degree := pn; 
  x_lc := px;
  PRAGMA INLINE(Odd_i,'YES');
  While Odd_i(degree) = 0 
  Loop
    PRAGMA INLINE(Half,'YES');
    degree := Half(degree);
    
    PRAGMA INLINE(mult_op,'YES');
    x_lc := mult_op(x_lc, x_lc);
  End Loop; 
  mresult := x_lc;
  
  PRAGMA INLINE(Half,'YES');
  degree := Half(degree);
  
  While degree != 0
  Loop
    x_lc := mult_op(x_lc, x_lc);
    PRAGMA INLINE(Odd_i,'YES');
    If Odd_i(degree) != 0
      Then
        PRAGMA INLINE(mult_op,'YES');        
        mresult := mult_op(mresult, x_lc);
    End If;
    PRAGMA INLINE(Half,'YES');
    degree := Half(degree);
  End Loop;
  Return mresult; 
End;   
------------------------

-- возведение в степень для пар Фибоначчи (по Степанову)
-- (возведение в степень способом русских крестьян (алгоритм Ахмеса))
Function Power_rpa( px in T_FIB_PARE
              , pn In Pls_integer -- целая степень
              ) return T_FIB_PARE  Deterministic Parallel_Enable
Is
  
  degree Pls_integer;
  x_lc T_FIB_PARE;
  mresult T_FIB_PARE;
Begin
  If pn = 0 Then return mlt_Identity_Element(px); End If;
  degree := pn;  
  x_lc := px;
  While Odd_i(degree) = 0 
  Loop
    degree := Half(degree);
    x_lc := mult_op(x_lc, x_lc);
  End Loop; 
  mresult := x_lc;
  degree := Half(degree);
  
  While degree != 0
  Loop
    x_lc := mult_op(x_lc, x_lc);
    If Odd_i(degree) != 0
      Then
        mresult := mult_op(mresult, x_lc);
    End If;
    degree := Half(degree);
  End Loop;
  Return mresult; 
End;                
------------------------

-- возведение числа в целочисленную степень
Function Power(px in Number
             , pn In Pls_integer -- целая степень
              ) return Number  Deterministic Parallel_Enable
is
 
Begin
  IF COALESCE(sign(px), 2) in (0,2) THEN Return px; END IF;
  Return CASE sign(pn)
         WHEN 1 THEN Power_rpa(px, pn)
         WHEN 0 THEN Power_rpa(px, pn)
         WHEN -1 THEN -- отрицательная степень
           1/Power_rpa(px, abs(pn))
         ELSE -- Null в показателе степени
           Cast(Null as number)  
         END;
    
End;
------------------------

-- дублировние строки pc_valx в количестве pn раз
Function Replicate(pc_valx in Varchar2, pn In Pls_integer -- количестов дублирований (степень)
                  ) return Varchar2 Deterministic Parallel_Enable
Is
Begin
  PRAGMA INLINE(Power_rpa,'YES');
  Return Power_rpa(pc_valx, pn);
End; 
------------------------

-- вычисление чисел Фибоначчи на парах по Степанову. (Возведение пар в степень)
-- follow Donald Knuth & Alex Stepanov ( see Sean Parent demonstration for full matrix version)
-- 193 - номер последнего числа, которое может быть правильно вычислено в PL/SQL (=9663391306290450775010025392525829059713).
-- 9999999999999999999999999999999999999999 - число до которого точно работает целочисленная арифметика в PL/SQL
-- 193-е число Фибоначчи - самое большое, не превышающее этого значения.
Function dkas_fib_p(pn In Number -- номер числа
                 ) Return Number Deterministic Parallel_Enable
Is
  Alex_Pare T_FIB_PARE; -- нижняя строка производящей матрицы 2x2 (см. Д. Кнут) ((1,1),(1,0))
  is_negativ_pwr boolean; -- знак степени
Begin
  -- начальное значение пары
  Alex_pare.m0 := 1;
  Alex_pare.m1 := 0;
  
  If pn = 0 Then Return 0; End If;
  is_negativ_pwr := (sign(pn) = -1);
  
  Return Case is_negativ_pwr
          When False Then  
            power_rpa(Alex_Pare, pn ).m0
          When True Then
            case Odd_i(abs(pn)) when 1 then 1 else -1 end * power_rpa(Alex_Pare, abs(pn) ).m0
          Else Cast(Null as Number)
          End;
  
End;                      
                   
  
end sqlru_pwr;
/
ALTER PACKAGE sqlru_pwr COMPILE BODY PLSQL_OPTIMIZE_LEVEL = 2;
SELECT level as rn,
  to_char( sqlru_pwr.dkas_fib_p(level), 'TM9') as fib2
  , -level
  , to_char( sqlru_pwr.dkas_fib_p(-level), 'TM9') as nega_fib2
  , sqlru_pwr.Replicate('-sql.ru-',level) as repl_demo
  , to_char(sqlru_pwr.Power(2, level), 'TM9') as pwr
  , to_char(sqlru_pwr.Power(2, -level), 'TM9') as nega_pwr
FROM  dual
CONNECT BY LEVEL < 194;