Delphi에서 XIRR 구현을 구현하는 방법은 무엇입니까?

Question

몇 시간 전, 나는 XIRR Excel function의 괜찮은 델파이 구현을 찾고 있었지만 찾을 수 없었습니다.

다른 델파이/오브젝트 파스칼 개발자에게 유용한 참고 자료가되기를 희망합니다.

아래 답변을 참조하십시오.

Answer 1

오히려 바퀴를 재발견보다, 내가 SysTools의 우수한 StFIN.pas에 보일 것이다

기능 NonperiodicIRR (CONST 값 : 더블의 배열을 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;