如何在Delphi中实现XIRR实现？

问题描述

|                                                                                                                       

解决方法

        与其重新发明轮子，不如看看SysTools出色的StFIN.pas： 函数NonperiodicIRR（const Values：Double的数组;                           const Dates：TStDate的数组；                           猜猜：扩展）：扩展; 您可以在这里获取： http://sourceforge.net/projects/tpsystools     ,        这是代码；

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;