# Paste: Financial functions

Author: Loryn Jenkins factor Mon, 8 Apr 2013 21:41:43
Plain Text |
```! Copyright (C) 2013 Loryn Jenkins.
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.
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```