How to implement XIRR implementation in Delphi? [closed]

It's difficult to tell what is being asked here. This question is ambiguous, vague, incomplete, overly broad, or rhetorical and cannot be reasonably answered in its current form. For help clarifying this question so that it can be reopened, visit the help center. Closed 11 years ago.开发者_运维技巧

Some time ago, I was looking for a decent Delphi implementation of the XIRR Excel function, but I wasn't able to find one.

I had to come up with my own, which I hope will be a useful reference for other Delphi / Object Pascal developers.

See the answer below.

---

Rather than reinvent the wheel, I would look at SysTools excellent StFIN.pas:

function NonperiodicIRR(const Values : array of Double; const Dates : array of TStDate; Guess : Extended) : Extended;

You can grab it here:

http://sourceforge.net/projects/tpsystools

---

Here is the code;

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;