; excel's xirr function
(define (julian year month day)
(let* ((a (quotient (- 14 month) 12))
(y (+ year 4800 (- a)))
(m (+ month (* 12 a) -3)))
(+ day
(quotient (+ (* 153 m) 2) 5)
(* 365 y)
(quotient y 4)
(- (quotient y 100))
(quotient y 400)
(- 32045))))
(define eps 0.0000001)
(define (deriv f x eps)
(/ (- (f (+ x eps)) (f x)) eps))
(define (newton f x)
(- x (/ (f x) (deriv f x eps))))
(define (npv ps ds x)
(let ((d (car ds)))
(let loop ((ps ps) (ds ds) (s 0))
(if (null? ps) s
(loop (cdr ps) (cdr ds)
(+ s (/ (car ps)
(expt (+ 1 x)
(/ (- (car ds) d)
365)))))))))
(define (xirr ps dates . args)
(let* ((guess (if (pair? args) (car args) 0.1))
(ds (map (lambda (d) (apply julian d)) dates))
(f (lambda (x) (npv ps ds x))))
(let loop ((x guess))
(let ((next (newton f x)))
(if (< (abs (- (f x) (f next))) eps) x
(loop next))))))
(display
(xirr '(10000 2000 -5500 3000 3500 -15000)
'((2001 5 1) (2002 3 1) (2002 5 1)
(2002 9 1) (2003 2 1) (2003 5 1))))
(newline)
(display
(xirr '(10000 2000 -5500 3000 3500 -10000)
'((2001 5 1) (2002 3 1) (2002 5 1)
(2002 9 1) (2003 2 1) (2003 5 1))))
(newline)
(display
(xirr '(-10000 2750 4250 3250 2750)
'((2008 1 1) (2008 3 1) (2008 10 30) (2009 2 15) (2009 4 1))))
(newline)