Вычисление IRR с использованием Optim

Я хочу найти внутреннюю норму доходности (IRR), в основном "ставку", которая заставляет мою функцию NPV стремиться к нулю, используя optim функция.

Мой текущий код для функции NPV (который работает):

npv <- function(rate, cf){
    r_v <- rep (rate,length (cf))
    t_v <- as.numeric (seq(1:length (cf)))
    pv <- cf * exp (-t_v*r_v)
    sum (pv)
} 

Я пытался использовать следующее optim функция:

InternalRateReturn <- optim(c(0,1), npv, cf = testcf2, gr = NULL, method = "L-BFGS-B", lower = -Inf, upper = Inf,control=list(), hessian = FALSE)

но он не вернется с правильным ответом для InternalRateReturn$par в отличие от использования uniroot метод ниже.

Могу ли я спросить, как изменить этот код (повторюсь, я просто хочу оптимизировать скорость в npv функция такая, что npv функция равна нулю)?

Функция IRR с использованием uniroot в соответствии с ниже:

irr1 <- function(cf) {
    uniroot(npv, c(0, 1), cf=cf)$root
}

2 ответа

Там довольно крутой пример использования optim рассчитать IRR по Мэтту Бригиде

### IRR Function:  Takes a vector of payments and returns a list which includes the internal rate of return ($IRR) and possible word of warning ($beware) ----

irr <- function(x, period = 1, starting.value = .1){

### This should detect the number of sign changes.  Should correctly not warn if there are many negative cash flows (so long as there is only 1 change in sign).

    irr.func <- function(r){ ( sum(x / (1 + r)^{0:(length(x)-1)}) )^2 }
    result <- optim(par = starting.value, fn = irr.func, method = "Brent", lower = -1000000, upper = 1000000)

    ## detecting number of sign changes
    x.ge.0 <- 1 * (x >= 0)
    changes <- diff(x.ge.0)
    changes <- changes * changes
    num.changes <- sum(changes)

    if( num.changes > 1) {

        statement <- "Your cash flows change more than once -- so you may have multiple IRRs. This function will only return the first IRR it finds. To find the others, you can try different starting values.  However, note the IRR does not make sense if the signs change more than once (try Modified IRR or NPV)."
        value <- period * result$par
        return(list(beware = statement, IRR = value))

    } else {

        return(list(IRR = period * result$par))

    }
}

Мэтт также имеет довольно полезную функцию для более реалистичного модифицированного IRR (который не делает необоснованных предположений о ставке реинвестирования)

### Modified IRR (MIRR) Function:  Takes a vector of payments and returns the MIRR by ----

mirr <- function(x, period = 1, starting.value = .1, discount.rate = 0.1, investment.rate = 0.05){

    ## move cash flows
    ## negative
    cf.neg <- (x < 0) * x
    ## discounted
    pv.cf.neg <- cf.neg / (1 + discount.rate)^{0:(length(x)-1)}
    pv <- sum(pv.cf.neg)

    ## positive
    cf.pos <- (x > 0) * x
    fv.cf.pos <- cf.pos * (1 + investment.rate)^{0:(length(x)-1)}
    fv <- sum(fv.cf.pos)

    mirr.per.period <- ( fv / abs(pv) )^{1 / (length(x))} - 1

    return( period * mirr.per.period )
} 

Если вам просто нужно вычислить IRR или NPV (или MIRR), и так как неясно, почему вам абсолютно необходимо использовать optimВы можете просто рассмотреть пакеты financial или же FinCal вместо взлома вашей собственной функции. Как это:

> require(financial)
> cf(c(-123400, 36200, 54800, 48100), i = 2.5)

Cash Flow Model

Flows:
      1       2       3       4 
-123400   36200   54800   48100 

 IRR%: 5.96 
 NPV Extremes at I%:  

   I%     NPV     NFV     NUS
1 2.5 8742.13 9414.32 3060.95

> require(FinCal)
> npv(c(-123400, 36200, 54800, 48100), r = 0.025)
[1] 8742.134
> irr(c(-123400, 36200, 54800, 48100))
[1] 0.05959787
Другие вопросы по тегам