# calculates NPV and IRR

# Assumes first cash flow is at time 0
npv1 <- function(i, cf, tt = seq(along = cf)) sum(cf / (1+i)^tt)

# http://www.mathepi.com/comp/discounting.html
# Compute net present value of payments received at the
# beginning of each time interval given the discount.rate.
# Payment 0 happens at time 0 (not time 1).
npv <- function(discount.rate, payments, nn=length(payments)) {
    sum(payments * (1/(1+discount.rate))^(0:(nn-1)))
}

# Payment 0 happens at time 1 (not time 0).
npv1 <- function(discount.rate, payments, nn=length(payments)) {
    sum(payments * (1/(1+discount.rate))^(1:nn))
}

# npv function with optional zero shift
npv.s = function(discount.rate, payments, npv0=0, fn) {
    fn(discount.rate, payments) - npv0
}

# Solve IRR
# npv must cross zero in the search range
irr = function(payments, npv0=0, fn=npv) {
    uniroot(npv.s, c(0.0, 1), payments=payments, npv0=npv0, fn=fn)$root
}

# Plot npv for range of discount rates
# Can be used as diagnostic and to find range where npv crosses
# zero (requirement for uniroot).
p.npv = function(t, r=c(0,1), fn=npv) {
    s = seq(r[1], r[2], (r[2]-r[1])/30)
    plot(s, sapply(s, fn, t, simplify=TRUE), type='l', 
        xlab="discount rate", ylab="NPV", main="NPV vs discount rate"
    )
    grid()
#    abline(0, 0, col='blue')
}

# Annotate with IRR
p.irr = function(t, fn=npv) {
    r = irr(t)
    points(r, 0)
    text(r, 0, sprintf('IRR = %2.2f%%', 100*r), pos=4, col='blue')
}

t = c(-8000, 100, 100, 100, 2000, 3000, 4000, 5000)
r = 0.1
npv(r, t)
#p.npv(t)
#p.npv(t, fn=npv1)
irr(t)

t2 = c(-8000, 9000, 7000, 6000, 4000)

