1 people like it.

Joint Life Annuity

This Joint Life Annuity calculation relies on the objects and functions defined in Single Life Annuity. A joint life annuity calculates the present value of an annuity from current age to death of a member and another life (spouse). The implementation below uses the AgeVectorBuilder from the Single Life Annuity snippet in two examples: The first defines a simple Joint Life Annuity that assumes no age difference between the two lives. The second assumes an N year age difference. The samples both rely on a male mortality table (PMA92 (C=2003)) and a female mortality table (PFA92 (C=2003)) which are extracts of publicly available mortality tables (http://www.actuaries.org.uk/research-and-resources/documents/pma92-pensioners-males-amounts).

 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: 
(AgeVector class and builder omitted)

(AgeVector helper functions omitted)

(mortality data omitted)

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

// Joint life annuity same age assumed
let jointLifeAnnuity = defaultAgeVector {
        let sa = defaultAgeVector.StartAge
        let ea = defaultAgeVector.EndAge
        let lb = defaultAgeVector.LowerBoundBehaviour
        let ub = defaultAgeVector.UpperBoundBehaviour
        let! pma92fn = pma92
        let! pfa92fn = new AgeVector<double>(1, ea, pfa92vals, lb, ub)
        let psFn = fun term -> 
            fun age -> ((AgeVectorFunctions.probSurvival pma92fn term) age)*((AgeVectorFunctions.probSurvival pfa92fn term) age)
        let asl = fun age ->
            [1..(ea - age)]
            |> List.fold  (fun acc a -> 
                    acc + (AgeVectorFunctions.pureEndowment (psFn) discFunc a) age) 0.0
         
        return (asl)
    }

// Joint life with age difference
let ageDiffedSpouse n = defaultAgeVector {
        let sa = defaultAgeVector.StartAge
        let ea = defaultAgeVector.EndAge
        let lb = defaultAgeVector.LowerBoundBehaviour
        let ub = defaultAgeVector.UpperBoundBehaviour
        let! pfa92fn = new AgeVector<double>(1, ea, pfa92vals, lb, ub)
        return (fun age -> pfa92fn (age - n))
    }

let jointLifeAnnuityAgeDiff = defaultAgeVector {
        let sa = defaultAgeVector.StartAge
        let ea = defaultAgeVector.EndAge
        let lb = defaultAgeVector.LowerBoundBehaviour
        let ub = defaultAgeVector.UpperBoundBehaviour
        let! pma92fn = pma92
        let! pfa92fn = ageDiffedSpouse 3
        let psFn = fun term -> 
            fun age -> ((AgeVectorFunctions.probSurvival pma92fn term) age)*
                        ((AgeVectorFunctions.probSurvival pfa92fn term) age)
        let asl = fun age ->
            [1..(ea - age)]
            |> List.fold  (fun acc a -> 
                    acc + (AgeVectorFunctions.pureEndowment (psFn) discFunc a) age) 0.0
         
        return (asl)
    }
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
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]

let pfa92vals = [0.0;0.0;0.0;0.0;0.0;0.0;0.0;0.0;0.0;0.0;0.0;0.0;0.0;0.0;0.0;
                 0.0;0.0;0.0;0.0;0.00014;0.00014;0.00014;
                 0.00014;0.00014;0.00014;0.000141;0.000142;0.000144;0.000146;
                 0.00015;0.000153;0.000159;0.000164;0.000172;0.000182;0.000193;
                 0.000206;0.000222;0.000241;0.000264;0.000291;0.000323;0.000361;
                 0.000405;0.000457;0.000518;0.000589;0.000671;0.000767;0.000878;
                 0.001006;0.001154;0.001324;0.00152;0.001744;0.001999;0.002291;
                 0.002624;0.003001;0.00343;0.003969;0.004585;0.005287;0.006084;
                 0.006989;0.008012;0.009166;0.010465;0.011924;0.013557;0.015381;
                 0.017413;0.019671;0.022174;0.024942;0.027994;0.03135;0.035029;
                 0.039055;0.043445;0.048222;0.053402;0.059006;0.065049;0.071549;
                 0.078518;0.085968;0.093911;0.10235;0.111291;0.120735;0.130678;
                 0.141114;0.152032;0.163418;0.175253;0.187516;0.20018;0.213215;
                 0.226587;0.240259;0.254192;0.26834;0.282658;0.2971;0.311616;
                 0.326156;0.340667;0.3551;0.369403;0.382406;0.39515;0.407594;
                 0.4197;0.431431;0.442752;0.45363;0.464038;0.473947;1.0]
val discFunc : term:Term -> ps:float -> float

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

from Script
val discount : pensionIncr:float -> intr:float -> term:Term -> float

Full name: Script.AgeVectorFunctions.discount
val pma92 : AgeVector<double>

Full name: Script.pma92
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>
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 pma92vals : float list

Full name: Script.pma92vals
union case boundaryBehaviour.Extend: boundaryBehaviour<'T>
val jointLifeAnnuity : AgeVector<float>

Full name: Script.jointLifeAnnuity
val defaultAgeVector : AgeVectorBuilder<float>

Full name: Script.defaultAgeVector
val sa : Age
property AgeVectorBuilder.StartAge: Age
val ea : Age
property AgeVectorBuilder.EndAge: Age
val lb : boundaryBehaviour<float>
property AgeVectorBuilder.LowerBoundBehaviour: boundaryBehaviour<float>
val ub : boundaryBehaviour<float>
property AgeVectorBuilder.UpperBoundBehaviour: boundaryBehaviour<float>
val pma92fn : (Age -> double)
val pfa92fn : (Age -> double)
val pfa92vals : float list

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

Full name: Script.AgeVectorFunctions.probSurvival
val asl : (Age -> float)
Multiple items
module List

from Microsoft.FSharp.Collections

--------------------
type List<'T> =
  | ( [] )
  | ( :: ) of Head: 'T * Tail: 'T list
  interface IEnumerable
  interface IEnumerable<'T>
  member Head : 'T
  member IsEmpty : bool
  member Item : index:int -> 'T with get
  member Length : int
  member Tail : 'T list
  static member Cons : head:'T * tail:'T list -> 'T list
  static member Empty : 'T list

Full name: Microsoft.FSharp.Collections.List<_>
val fold : folder:('State -> 'T -> 'State) -> state:'State -> list:'T list -> 'State

Full name: Microsoft.FSharp.Collections.List.fold
val acc : float
val a : int
val pureEndowment : psFunc:(Term -> Age -> double) -> discountToTerm:(Term -> double -> double) -> term:Term -> (Age -> double)

Full name: Script.AgeVectorFunctions.pureEndowment
val ageDiffedSpouse : n:Age -> AgeVector<float>

Full name: Script.ageDiffedSpouse
val n : Age
val jointLifeAnnuityAgeDiff : AgeVector<float>

Full name: Script.jointLifeAnnuityAgeDiff
val pfa92fn : (Age -> float)
Next Version Raw view Test code New version

More information

Link:http://fssnip.net/f5
Posted:12 years ago
Author:Kevin Roche
Tags: actuarial , annuity , computation expression