Paste: Financial functions

! Copyright (C) 2013 Loryn Jenkins.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel accessors locals combinators sequences math math.order math.functions 
math.ranges arrays vectors math.constants classes fry ;

IN: financial

:: pv ( rate period payment -- pv )
    rate 1 + period ^ recip payment * ;
    
:: present-values ( rate cashflows -- discounted-cashflows )
    cashflows [ :> ( pmt i ) rate i 1 + pmt pv ] map-index ;

: (summation) ( seq -- newseq )
    0 [ + ] accumulate 
    >vector swap suffix! ;

: payback ( investment cashflows -- period )
    swap '[ _ (summation) [ _ >= ] find drop ] call ;    

:: discounted-payback ( rate investment cashflows -- period ) 
    rate cashflows present-values (summation) [ investment >= ] find drop ;
         
:: npv ( rate investment cashflows -- npv ) 
    rate cashflows present-values sum investment - ;  
    
! IRR

CONSTANT: tolerance 0.000001
CONSTANT: max-iterations 500
CONSTANT: min-bound -2147483648
CONSTANT: max-bound 2147483647

:: initial-estimates ( guess investment cashflows -- npv1 r1 r2 )
    cashflows [ sum ] [ length ] bi :> ( s l )
    s investment abs / :> ac
    guess investment cashflows npv :> npv0
    ac 2 l 1 + / ^ 1 - :> r1
    ac log s npv0 / log / :> p
    p complex? [ guess ] [ r1 1 + p ^ 1 - ] if :> r2
    r1 investment cashflows npv :> npv1 
    npv1 r1 r2 ;   

: single-outflow? ( investment cashflows -- ? )
    [ 0 < ] filter empty?
    [ zero? not ] dip 
    and ;         

: within-bounds? ( est-rate -- ? )
    dup [ min-bound max-bound between? ] when ;

: converged? ( npv -- ? )
    abs tolerance <= ;

! Newton-Raphson algorithm

:: (pv-first-derivative) ( rate period payment -- r )
    rate 1 + period 1 - ^ recip payment period * * neg ;    
    
:: (irr-derivative-sum) ( rate investment cashflows -- sum )
    cashflows [ :> ( pmt i ) rate i 1 + pmt (pv-first-derivative) ] map-index 
    sum investment - ;

:: (newton-raphson) ( iterations npv1 r1 investment cashflows -- result )
    r1 within-bounds? iterations max-iterations < and 
    [ npv1
      r1 investment cashflows (irr-derivative-sum) /
      r1 swap - :> r2
      r2 investment cashflows npv :> npv2 
      npv2 converged? [ r2 ] [
        iterations 1 + npv2 r2 investment cashflows (newton-raphson) 
      ] if
    ] [ f ] if ;
    
: irr-newton-raphson ( guess investment cashflows -- irr )
    [ 0 ] 3dip
    [ initial-estimates + 2 / ] 2keep
    (newton-raphson) ;

! Secant algorithm

:: (secant) ( iterations npv1 r1 r2 investment cashflows -- result )
    r2 within-bounds? iterations max-iterations < and
    [ r2 investment cashflows npv :> npv2
      npv2 converged? [ r2 ] [
        r2 r1 - npv2 npv1 - / npv2 * r2 swap - :> r3       
        iterations 1 + npv2 r2 r3 investment cashflows (secant)
      ] if
    ] [ f ] if ;
     
: irr-secant ( guess investment cashflows -- irr )
    [ 0 ] 3dip [ initial-estimates ] 2keep (secant) ;
            
! General IRR function

: irr ( guess investment cashflows -- irr )
    irr-secant ;


! Copyright (C) 2013 Loryn Jenkins.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel tools.test financial math math.functions ;
IN: financial.tests


: cashflow1 ( -- seq )
   { 4000.00 400.00 3000.00 2000.00 1000.00 } clone ;
   
: cashflow2 ( -- seq )
    { 100.00 } clone ;
    
: cashflow3 ( -- seq )
    { 4000.00 -400.00 3000.00 2000.00 1000.00 } clone ;
    
: cashflow4 ( -- seq )
    { 1000.00 -1000.00 1000.00 5000.00 } clone ;

[ 3 ] [ 7000.00 cashflow1 payback ] unit-test  

[ 4 ] [ 0.09 7000.00 cashflow1 discounted-payback ] unit-test   

[ 138973.0 ]  [ 0.09 7000.00 cashflow1 npv 2 10^ * round ] unit-test  

[ 1779.0 ]  [ 0.09 7000.00 cashflow1 irr 4 10^ * round ] unit-test

[ 0.0 ]  [ 0.09 100.00 cashflow2 irr 4 10^ * round ] unit-test

[ 0.0 ]  [ 0.09 100.00 cashflow2 irr-secant 4 10^ * round ] unit-test

[ 0.0 ]  [ 0.09 100.00 cashflow2 irr-newton-raphson 4 10^ * round ] unit-test

[ 13511.0 ] [ 0.09 7000.00 cashflow3 irr-secant 5 10^ * round ] unit-test

[ 13511.0 ] [ 0.09 7000.00 cashflow3 irr-newton-raphson 5 10^ * round ] unit-test

[ -1283.0 ] [ 0.09 10000.00 cashflow4 irr 4 10^ * round ] unit-test

[ -1283.0 ] [ 0.09 10000.00 cashflow4 irr-secant 4 10^ * round ] unit-test

[ -1283.0 ] [ 0.09 10000.00 cashflow4 irr-newton-raphson 4 10^ * round ] unit-test

[ 1771.0 ] [ 0.09 158963578.00 
{ 17485993.58 17485382.58 17485123.58 17485234.58 17485345.58 17485456.58 17485678.58 17485890.58 17485878.58 17485343.58 }
irr-newton-raphson 5 10^ * round ] unit-test

[ 1771.0 ] [ 0.09 158963578.00 
{ 17485993.58 17485382.58 17485123.58 17485234.58 17485345.58 17485456.58 17485678.58 17485890.58 17485878.58 17485343.58 }
irr-secant 5 10^ * round ] unit-test
Author:	Loryn Jenkins
Mode:	factor
Date:	Mon, 8 Apr 2013 21:41:43