DelphiでXIRRの実装を実装するには？

Question

いくつかの時間前、私はXIRR Excel functionのまともなDelphiの実装を探していましたが、私は1つを見つけることができませんでした。

私は他のDelphi/Object Pascalの開発者にとって便利な参照ことを願っている、私自身を考え出す必要がありました。

は、以下の回答を参照してください。

Answer 1

むしろ車輪の再発明よりも、私はのSysTools優れたStFIN.pasになります

関数NonperiodicIRR（定数値：ダブルの配列; constの日程：TStDateの配列; ゲス：拡張）：拡張。

あなたはここでそれをつかむことができます：ここで

http://sourceforge.net/projects/tpsystools

Answer 2

はコードです。

function XIRR(Values: array of double; Dates: array of tDateTime; var Rate: double): Boolean; 
const MAX_STEPS = 100; 

    function CalcValue(Rate: double): double; 
     function disc(d: tDateTime; v: double): double; 
     var 
      Exp, coef: double; 
     begin 
      Exp := (d - Dates[0])/365; 
      coef := Power(1 + Rate/100, Exp); 
      result := v/coef; 
     end; 
    var 
     i: integer; 
    begin 
     result := 0; 
     for i := 0 to High(Dates) do 
      result := result + disc(Dates[i], Values[i]); 
    end; 

var 
    SaveFPUCW: word; 
    CWChgReq: Boolean; 
    Rate1, Rate2, RateN: double; 
    F1, F2, FN, dF, Scale: double; 
    Quit: Boolean; 
    N: integer; 
begin 
    RateN := 0; 
    FN := 0; 
    Assert(length(Values) = length(Dates)); 
    Assert(length(Values) >= 2); 
    SaveFPUCW := Get8087CW; 
    CWChgReq := (SaveFPUCW and $1F3F) <> $1332; 
    If CWChgReq then Set8087CW($1332); 
    try 
     result := true; 
     Rate1 := Rate; 
     Rate2 := Rate + 1; 
     Quit := false; 
     N := 0; 
     Scale := 1; 
     F1 := CalcValue(Rate1); 
     F2 := CalcValue(Rate2); 
     while not Quit do 
     begin 
      if (F2 = F1) or (Rate2 = Rate1) then 
      begin 
       Quit := true; 
       result := false; 
      end 
      else 
      begin 
       dF := (F2 - F1)/(Rate2 - Rate1); 
       RateN := Rate1 + (0 - F1)/dF/Scale; 
       N := N + 1; 
       if RateN > -100 then := CalcValue(RateN); 
       if Abs(RateN - Rate1)/((Abs(Rate1) + Abs(Rate2))/2) < 0.0000005 then 
        Quit := true 
       else if N >= MAX_STEPS then 
       begin 
        Quit := true; 
        result := false; 
       end 
       else if not(RateN > -100) then 
       begin 
        Scale := Scale * 2; 
       end 
       else 
       begin 
        Scale := 1; 
        Rate2 := Rate1; 
        F2 := F1; 
        Rate1 := RateN; 
        F1 := FN; 
       end; 
      end; 
     end; 
     if result then Rate := RateN 
     else Rate := 0; 
    Finally 
     If CWChgReq then Set8087CW(SaveFPUCW); 
    end; 
end;