7 people like it.

Single Life Annuity

A single life annuity function in F# including supporting functions such as probability of survival, pure endowment and discounted interest rate calculation. I've gone for (what I believe to be) a more functional approach than the previous version. I've cobbled together a sort of computation expression type to facilitate transforming the AgeVector. The code below contains test data and sample tests so that you can see how it should be used. If you have any queries or advice about this please contact me on twitter @CdeRoiste . Have fun!

  1: 
  2: 
  3: 
  4: 
  5: 
  6: 
  7: 
  8: 
  9: 
 10: 
 11: 
 12: 
 13: 
 14: 
 15: 
 16: 
 17: 
 18: 
 19: 
 20: 
 21: 
 22: 
 23: 
 24: 
 25: 
 26: 
 27: 
 28: 
 29: 
 30: 
 31: 
 32: 
 33: 
 34: 
 35: 
 36: 
 37: 
 38: 
 39: 
 40: 
 41: 
 42: 
 43: 
 44: 
 45: 
 46: 
 47: 
 48: 
 49: 
 50: 
 51: 
 52: 
 53: 
 54: 
 55: 
 56: 
 57: 
 58: 
 59: 
 60: 
 61: 
 62: 
 63: 
 64: 
 65: 
 66: 
 67: 
 68: 
 69: 
 70: 
 71: 
 72: 
 73: 
 74: 
 75: 
 76: 
 77: 
 78: 
 79: 
 80: 
 81: 
 82: 
 83: 
 84: 
 85: 
 86: 
 87: 
 88: 
 89: 
 90: 
 91: 
 92: 
 93: 
 94: 
 95: 
 96: 
 97: 
 98: 
 99: 
100: 
101: 
102: 
103: 
104: 
105: 
106: 
107: 
108: 
109: 
110: 
111: 
112: 
113: 
114: 
115: 
116: 
117: 
118: 
119: 
120: 
121: 
122: 
123: 
124: 
125: 
126: 
127: 
128: 
129: 
130: 
131: 
132: 
133: 
134: 
135: 
136: 
137: 
138: 
139: 
140: 
141: 
142: 
143: 
144: 
145: 
146: 
147: 
148: 
149: 
150: 
151: 
152: 
153: 
154: 
155: 
156: 
157: 
158: 
159: 
160: 
161: 
162: 
163: 
164: 
165: 
166: 
open System.Collections.Generic
open System.Threading

// **************************************************************
// Defines an AgeVector type which "generates" values at each age 
// according to a generator function.
// **************************************************************
type Age = int
type Term = int

let (|ValidAge|InvalidAge|) (age : Age) =
    if age >= 0 && age <= 120 then
        ValidAge (age)
    else
        InvalidAge

type boundaryBehaviour<'T> =
    | Zero of 'T
    | One of 'T
    | Fixed of 'T
    | Extend
    | Fail

type IAgeVector<'T> =
    abstract member StartAge : Age
    abstract member EndAge : Age
    abstract member ValueAtAge : Age -> 'T
    abstract member LowerBoundBehaviour : boundaryBehaviour<'T>
    abstract member UpperBoundBehaviour : boundaryBehaviour<'T>

type AgeVector<'T> (startAge,
                    endAge, 
                    generator,
                    lowerBoundBehaviour,
                    upperBoundBehaviour) =
    
    member private this.boundary boundaryAge = function
        | Zero v -> v
        | One v -> v
        | Fixed(v) -> v
        | Extend -> this.AtAge boundaryAge
        | Fail -> failwith "Requested Age is out of bounds and no substitute value has been declared."
    
    member this.AtAge age = (this :> IAgeVector<'T>).ValueAtAge age
    
    interface IAgeVector<'T> with
        member this.StartAge with get () = startAge
        member this.EndAge with get () = endAge
        member this.ValueAtAge age =
            match age with
            | ValidAge v when v < startAge -> this.boundary startAge lowerBoundBehaviour
            | ValidAge v when v > endAge -> this.boundary endAge upperBoundBehaviour
            | ValidAge v -> generator v
            | _ -> failwith "Invalid age."
        member this.LowerBoundBehaviour with get() = lowerBoundBehaviour
        member this.UpperBoundBehaviour with get() = upperBoundBehaviour
 
    new (startAge, 
         endAge,
         data : seq<'T>,
         lowerBoundBehaviour,
         upperBoundBehaviour) =
        let generator (age : Age) = 
            data 
            |> Seq.nth (age - startAge)
        new AgeVector<'T> (startAge, 
                           endAge, 
                           generator,
                           lowerBoundBehaviour,
                           upperBoundBehaviour)


// ***************************************************************
// Implement builder logic
// ***************************************************************
let bind (av : AgeVector<'T>) (rest : (Age -> 'T) -> AgeVector<'U>) : AgeVector<'U> = rest av.AtAge

type AgeVectorBuilder<'T>(startAge : Age,
                          endAge : Age,
                          lowerBoundBehaviour : boundaryBehaviour<'T>,
                          upperBoundBehaviour : boundaryBehaviour<'T>) =
    member this.StartAge with get () = startAge
    member this.EndAge with get () = endAge
    member this.LowerBoundBehaviour with get () = lowerBoundBehaviour
    member this.UpperBoundBehaviour with get () = upperBoundBehaviour

    member this.Delay(f) = f()
    member this.Return (genFunc : Age -> 'T) = 
        new AgeVector<'T>(startAge, endAge, genFunc, lowerBoundBehaviour, upperBoundBehaviour)
    member this.ReturnFrom(genFunc : Age -> 'T) = genFunc
    member this.Bind (av, rest) = bind av rest
    member this.Let (av, rest) : AgeVector<'T> = rest av        
    
let defaultAgeVector = new AgeVectorBuilder<_>(18, 120, Zero (0.0), Fail)

// ***************************************************************
module AgeVectorFunctions =

    let probSurvival ageVectorFn (term : Term) =
        let psFunc (age : Age) = 
            [age .. (age + term - 1)]
            |> List.fold (fun acc age -> acc * (1.0 - (ageVectorFn age))) 1.0
        psFunc

    let discount pensionIncr intr (term : Term) =
        ((1.0 + pensionIncr) / (1.0 + intr)) ** (double)term

    let pureEndowment (psFunc : Term -> (Age -> double)) (discountToTerm : Term -> (double -> double)) = 
        fun term -> (psFunc term) >> (discountToTerm  term)
        
    let transform f ageVector =
        let genFunc = f << (ageVector :> IAgeVector<_>).ValueAtAge
        let newAgeVector = new AgeVector<_> (
                                ageVector.StartAge,
                                ageVector.EndAge,
                                genFunc,
                                ageVector.LowerBoundBehaviour,
                                ageVector.UpperBoundBehaviour)
        newAgeVector

// *******************************************************************
// Test data - mortality table from 18 - 120. This is simply an extract 
// of the publicly available PMA92 (C=2003) mortality table.
// *******************************************************************
let pma92vals = 
    [0.00;0.00;0.000235;0.000233;0.000233;0.000231;0.000231;0.000230;
     0.000229;0.000229;0.000229;0.000229;0.000230;0.000231;0.000233;
     0.000237;0.000241;0.000247;0.000254;0.000262;0.000274;0.000288;
     0.000306;0.000328;0.000355;0.000388;0.000428;0.000476;0.000535;
     0.000605;0.000689;0.000789;0.000908;0.001049;0.001216;0.001413;
     0.001643;0.001914;0.00223;0.002597;0.003023;0.003516;0.004085;
     0.004806;0.005642;0.00661;0.007725;0.009006;0.010474;0.012149;
     0.014054;0.016214;0.018653;0.021399;0.024479;0.027922;0.031756;
     0.03601;0.040712;0.04589;0.051571;0.05778;0.064539;0.071867;
     0.079782;0.088295;0.097414;0.107142;0.117477;0.128409;0.139923;
     0.151999;0.164609;0.177718;0.191285;0.205265;0.219604;0.234247;
     0.24913;0.264188;0.279353;0.294553;0.309716;0.32477;0.339641;
     0.35426;0.368556;0.382461;0.395911;0.408847;0.421211;0.432949;
     0.444014;0.453033;0.461297;0.46878;0.475459;0.481313;0.486326;
     0.490484;0.493776;0.496194;1.0]

//// some Tests
let discFunc term = fun ps -> (AgeVectorFunctions.discount 0.02 0.03 term) * ps
let pma92 = new AgeVector<double>(18, 120, pma92vals, Extend, Extend)

let simpleScaling = defaultAgeVector {
        let halveIt = fun dblVal -> dblVal*0.5
        let! pma92fn = pma92
        return (pma92fn >> halveIt)}

let simpleShift n = defaultAgeVector {
        let! pma92fn = pma92
        return (fun age -> pma92fn (age - n))}

let singleLifeAnnuity = defaultAgeVector {
        let ea = defaultAgeVector.EndAge
        let! pma92fn = pma92
        let psFn = fun term -> AgeVectorFunctions.probSurvival pma92fn term
        let asl = fun age ->
            [1..(ea - age)]
            |> List.fold  (fun acc a -> 
                    let pe = (AgeVectorFunctions.pureEndowment (psFn) discFunc a) age
                    acc + (AgeVectorFunctions.pureEndowment (psFn) discFunc a) age) 0.0
         
        return (asl)
    }
namespace System
namespace System.Collections
namespace System.Collections.Generic
namespace System.Threading
type Age = int

Full name: Script.Age
Multiple items
val int : value:'T -> int (requires member op_Explicit)

Full name: Microsoft.FSharp.Core.Operators.int

--------------------
type int = int32

Full name: Microsoft.FSharp.Core.int

--------------------
type int<'Measure> = int

Full name: Microsoft.FSharp.Core.int<_>
type Term = int

Full name: Script.Term
val age : Age
type boundaryBehaviour<'T> =
  | Zero of 'T
  | One of 'T
  | Fixed of 'T
  | Extend
  | Fail

Full name: Script.boundaryBehaviour<_>
union case boundaryBehaviour.Zero: 'T -> boundaryBehaviour<'T>
union case boundaryBehaviour.One: 'T -> boundaryBehaviour<'T>
union case boundaryBehaviour.Fixed: 'T -> boundaryBehaviour<'T>
union case boundaryBehaviour.Extend: boundaryBehaviour<'T>
union case boundaryBehaviour.Fail: boundaryBehaviour<'T>
type IAgeVector<'T> =
  interface
    abstract member ValueAtAge : Age -> 'T
    abstract member EndAge : Age
    abstract member LowerBoundBehaviour : boundaryBehaviour<'T>
    abstract member StartAge : Age
    abstract member UpperBoundBehaviour : boundaryBehaviour<'T>
  end

Full name: Script.IAgeVector<_>
abstract member IAgeVector.StartAge : Age

Full name: Script.IAgeVector`1.StartAge
abstract member IAgeVector.EndAge : Age

Full name: Script.IAgeVector`1.EndAge
abstract member IAgeVector.ValueAtAge : Age -> 'T

Full name: Script.IAgeVector`1.ValueAtAge
abstract member IAgeVector.LowerBoundBehaviour : boundaryBehaviour<'T>

Full name: Script.IAgeVector`1.LowerBoundBehaviour
abstract member IAgeVector.UpperBoundBehaviour : boundaryBehaviour<'T>

Full name: Script.IAgeVector`1.UpperBoundBehaviour
Multiple items
type AgeVector<'T> =
  interface IAgeVector<'T>
  new : startAge:Age * endAge:Age * generator:(Age -> 'T) * lowerBoundBehaviour:boundaryBehaviour<'T> * upperBoundBehaviour:boundaryBehaviour<'T> -> AgeVector<'T>
  new : startAge:Age * endAge:Age * data:seq<'T> * lowerBoundBehaviour:boundaryBehaviour<'T> * upperBoundBehaviour:boundaryBehaviour<'T> -> AgeVector<'T>
  member AtAge : age:Age -> 'T
  member private boundary : boundaryAge:Age -> (boundaryBehaviour<'T> -> 'T)

Full name: Script.AgeVector<_>

--------------------
new : startAge:Age * endAge:Age * data:seq<'T> * lowerBoundBehaviour:boundaryBehaviour<'T> * upperBoundBehaviour:boundaryBehaviour<'T> -> AgeVector<'T>
new : startAge:Age * endAge:Age * generator:(Age -> 'T) * lowerBoundBehaviour:boundaryBehaviour<'T> * upperBoundBehaviour:boundaryBehaviour<'T> -> AgeVector<'T>
val startAge : Age
val endAge : Age
val generator : (Age -> 'T)
val lowerBoundBehaviour : boundaryBehaviour<'T>
val upperBoundBehaviour : boundaryBehaviour<'T>
val this : AgeVector<'T>
member private AgeVector.boundary : boundaryAge:Age -> (boundaryBehaviour<'T> -> 'T)

Full name: Script.AgeVector`1.boundary
val boundaryAge : Age
val v : 'T
member AgeVector.AtAge : age:Age -> 'T
val failwith : message:string -> 'T

Full name: Microsoft.FSharp.Core.Operators.failwith
member AgeVector.AtAge : age:Age -> 'T

Full name: Script.AgeVector`1.AtAge
override AgeVector.StartAge : Age

Full name: Script.AgeVector`1.StartAge
override AgeVector.EndAge : Age

Full name: Script.AgeVector`1.EndAge
override AgeVector.ValueAtAge : age:Age -> 'T

Full name: Script.AgeVector`1.ValueAtAge
active recognizer ValidAge: Age -> Choice<Age,unit>

Full name: Script.( |ValidAge|InvalidAge| )
val v : Age
member private AgeVector.boundary : boundaryAge:Age -> (boundaryBehaviour<'T> -> 'T)
override AgeVector.LowerBoundBehaviour : boundaryBehaviour<'T>

Full name: Script.AgeVector`1.LowerBoundBehaviour
override AgeVector.UpperBoundBehaviour : boundaryBehaviour<'T>

Full name: Script.AgeVector`1.UpperBoundBehaviour
val data : seq<'T>
Multiple items
val seq : sequence:seq<'T> -> seq<'T>

Full name: Microsoft.FSharp.Core.Operators.seq

--------------------
type seq<'T> = IEnumerable<'T>

Full name: Microsoft.FSharp.Collections.seq<_>
module Seq

from Microsoft.FSharp.Collections
val nth : index:int -> source:seq<'T> -> 'T

Full name: Microsoft.FSharp.Collections.Seq.nth
val bind : av:AgeVector<'T> -> rest:((Age -> 'T) -> AgeVector<'U>) -> AgeVector<'U>

Full name: Script.bind
val av : AgeVector<'T>
val rest : ((Age -> 'T) -> AgeVector<'U>)
Multiple items
type AgeVectorBuilder<'T> =
  new : startAge:Age * endAge:Age * lowerBoundBehaviour:boundaryBehaviour<'T> * upperBoundBehaviour:boundaryBehaviour<'T> -> AgeVectorBuilder<'T>
  member Bind : av:AgeVector<'a> * rest:((Age -> 'a) -> AgeVector<'b>) -> AgeVector<'b>
  member Delay : f:(unit -> 'a) -> 'a
  member Let : av:'a * rest:('a -> AgeVector<'T>) -> AgeVector<'T>
  member Return : genFunc:(Age -> 'T) -> AgeVector<'T>
  member ReturnFrom : genFunc:(Age -> 'T) -> (Age -> 'T)
  member EndAge : Age
  member LowerBoundBehaviour : boundaryBehaviour<'T>
  member StartAge : Age
  member UpperBoundBehaviour : boundaryBehaviour<'T>

Full name: Script.AgeVectorBuilder<_>

--------------------
new : startAge:Age * endAge:Age * lowerBoundBehaviour:boundaryBehaviour<'T> * upperBoundBehaviour:boundaryBehaviour<'T> -> AgeVectorBuilder<'T>
val this : AgeVectorBuilder<'T>
member AgeVectorBuilder.StartAge : Age

Full name: Script.AgeVectorBuilder`1.StartAge
member AgeVectorBuilder.EndAge : Age

Full name: Script.AgeVectorBuilder`1.EndAge
member AgeVectorBuilder.LowerBoundBehaviour : boundaryBehaviour<'T>

Full name: Script.AgeVectorBuilder`1.LowerBoundBehaviour
member AgeVectorBuilder.UpperBoundBehaviour : boundaryBehaviour<'T>

Full name: Script.AgeVectorBuilder`1.UpperBoundBehaviour
member AgeVectorBuilder.Delay : f:(unit -> 'a) -> 'a

Full name: Script.AgeVectorBuilder`1.Delay
val f : (unit -> 'a)
member AgeVectorBuilder.Return : genFunc:(Age -> 'T) -> AgeVector<'T>

Full name: Script.AgeVectorBuilder`1.Return
val genFunc : (Age -> 'T)
member AgeVectorBuilder.ReturnFrom : genFunc:(Age -> 'T) -> (Age -> 'T)

Full name: Script.AgeVectorBuilder`1.ReturnFrom
member AgeVectorBuilder.Bind : av:AgeVector<'a> * rest:((Age -> 'a) -> AgeVector<'b>) -> AgeVector<'b>

Full name: Script.AgeVectorBuilder`1.Bind
val av : AgeVector<'a>
val rest : ((Age -> 'a) -> AgeVector<'b>)
member AgeVectorBuilder.Let : av:'a * rest:('a -> AgeVector<'T>) -> AgeVector<'T>

Full name: Script.AgeVectorBuilder`1.Let
val av : 'a
val rest : ('a -> AgeVector<'T>)
val defaultAgeVector : AgeVectorBuilder<float>

Full name: Script.defaultAgeVector
val probSurvival : ageVectorFn:(Age -> float) -> term:Term -> (Age -> float)

Full name: Script.AgeVectorFunctions.probSurvival
val ageVectorFn : (Age -> float)
val term : Term
val psFunc : (Age -> float)
Multiple items
type List<'T> =
  new : unit -> List<'T> + 2 overloads
  member Add : item:'T -> unit
  member AddRange : collection:IEnumerable<'T> -> unit
  member AsReadOnly : unit -> ReadOnlyCollection<'T>
  member BinarySearch : item:'T -> int + 2 overloads
  member Capacity : int with get, set
  member Clear : unit -> unit
  member Contains : item:'T -> bool
  member ConvertAll<'TOutput> : converter:Converter<'T, 'TOutput> -> List<'TOutput>
  member CopyTo : array:'T[] -> unit + 2 overloads
  ...
  nested type Enumerator

Full name: System.Collections.Generic.List<_>

--------------------
List() : unit
List(capacity: int) : unit
List(collection: IEnumerable<'T>) : unit
val fold : folder:('State -> 'T -> 'State) -> state:'State -> list:'T list -> 'State

Full name: Microsoft.FSharp.Collections.List.fold
val acc : float
val discount : pensionIncr:float -> intr:float -> term:Term -> float

Full name: Script.AgeVectorFunctions.discount
val pensionIncr : float
val intr : float
Multiple items
val double : value:'T -> float (requires member op_Explicit)

Full name: Microsoft.FSharp.Core.ExtraTopLevelOperators.double

--------------------
type double = System.Double

Full name: Microsoft.FSharp.Core.double
val pureEndowment : psFunc:(Term -> Age -> double) -> discountToTerm:(Term -> double -> double) -> term:Term -> (Age -> double)

Full name: Script.AgeVectorFunctions.pureEndowment
val psFunc : (Term -> Age -> double)
val discountToTerm : (Term -> double -> double)
val transform : f:('a -> 'a) -> ageVector:IAgeVector<'a> -> AgeVector<'a>

Full name: Script.AgeVectorFunctions.transform
val f : ('a -> 'a)
val ageVector : IAgeVector<'a>
val genFunc : (Age -> 'a)
val newAgeVector : AgeVector<'a>
property IAgeVector.StartAge: Age
property IAgeVector.EndAge: Age
property IAgeVector.LowerBoundBehaviour: boundaryBehaviour<'a>
property IAgeVector.UpperBoundBehaviour: boundaryBehaviour<'a>
val pma92vals : float list

Full name: Script.pma92vals
val discFunc : term:Term -> ps:float -> float

Full name: Script.discFunc
val ps : float
module AgeVectorFunctions

from Script
val pma92 : AgeVector<double>

Full name: Script.pma92
val simpleScaling : AgeVector<float>

Full name: Script.simpleScaling
val halveIt : (float -> float)
val dblVal : float
val pma92fn : (Age -> double)
val simpleShift : n:Age -> AgeVector<float>

Full name: Script.simpleShift
val n : Age
val singleLifeAnnuity : AgeVector<float>

Full name: Script.singleLifeAnnuity
val ea : Age
property AgeVectorBuilder.EndAge: Age
val psFn : (Term -> Age -> float)
val asl : (Age -> float)
val a : int
val pe : double

More information

Link:http://fssnip.net/bp
Posted:9 years ago
Author:Kevin Roche
Tags: actuarial , annuity