; 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)

0.09706406163330174
-0.16569819230700178
0.37336253350981735