Modeling Long Term Care Insurance

Seth J. Chandler

University of Houston Law Center
schandler@uh.edu

With[{is=200},Row[{Rasterize[DynamicModule[{cnf=10,incept=52,r=0.06`,α=1,β=1,γ=1},reserveManipulate[{γ,α,β},r,incept,cnf]],ImageSize->is],Rasterize[DynamicModule[{incept=52,rActual=0.06`,rAnticipated=0.06`,verticalPlotRangeControl=All,αActual=1,αAnticipated=1,βActual=1,βAnticipated=1,γActual=1,γAnticipated=1},profitManipulate[{{γActual,γAnticipated},{αActual,αAnticipated},{βActual,βAnticipated}},{rActual,rAnticipated},incept,verticalPlotRangeControl]],ImageSize->is],Rasterize[DynamicModule[{incept=52,rt=10,r=0.06`,verticalPlotRangeControl=All},repricingManipulate[r,incept,rt,verticalPlotRangeControl]],ImageSize->is]}]]

What is Long Term Care Insurance (LTCI)?

Long term care insurance in the United States and elsewhere provides benefits to individuals whose physical or severe cognitive disabilities render them unable to perform the basic activities of daily living such as eating, toileting or dressing.

Why is modeling LTCI important

LTCI is important

8 million current policies in United States

Burden of LTC for uninsured is high and growing rapidly as population ages

Market impediments may reduce beneficial risk transfer and lead to problematic socialization of risk

Failure to provide LTC can reduce health and quality of life

Good public domain LTCI models are needed to better regulate LTCI and increase its appropriate use

Huge potentials for abuse exist right now

Difficult for purchasers to make intelligent decisions

Difficult for legislators to understand

Mathematica is a useful analysis and communications tool

A look at a typical LTCI

Parameters

• premium function of time, health state, cumulative premium increases, "contingent non-forfeiture" trigger

• benefit function of current health state, health state history, cumulative limit, per period limit, inflation protection

Three unusual features

No cash surrender value by default

If you lapse, you receive no return on premiums, unless you are among the very few who elect to purchase a "Non-forfeiture rider"

Right to increase premiums (repricing)

Framed["Premiums are subject to change. We can only change the premium for this Policy if we change premiums for everyone in your state with the same Policy form.",Background->Lighter[RGBColor[0.4494697489890898,0.7013504234378576,0.1671320668345159],0.5],FrameStyle->Darker[RGBColor[0.,0.5593194476234074,0.7058823529411765],0.5]]

"Contingent Non-Forfeiture"

Framed["If we increase the premium rates under this Policy which results in a cumulative increase of the annual premium equal to or exceeding the percentage of your initial annual premium at issue age, as set forth in the table below ... this Policy may be converted to a paid-up status with the Shortened benefit Period described below. .... The Benefit Amount becomes equal to the greater of (a) the total of premiums paid for this Policy and all riders; or (b) thirty times the Daily Benefit in effect on the date of lapse. No further benefit increases will occur under any Inflation Protection Rider.",Background->Lighter[RGBColor[0.4494697489890898,0.7013504234378576,0.1671320668345159],0.5],FrameStyle->Darker[RGBColor[0.,0.5593194476234074,0.7058823529411765],0.5]]

Labeled[ListLinePlot[Table[contingentNonForfeitureTrigger[x],{x,10,99}],PlotMarkers->{Automatic,Tiny},Frame->True,FrameLabel->{"insured's age at inception","cumulative premium increase"},BaseStyle->FontSize->18,Filling->{1->3.00,1->0},FillingStyle->{themeColor1,themeColor2},PlotRange->{Automatic,{0,2.4}},Epilog->{Text["triggered",{60,1.50}],Text[Style["not triggered",White],{20,0.5}]}],Pane[Style["What combinations of age at inception and cumulative premium increases trigger contingent non-forfeiture rights?",FontFamily->"Times",FontSize->18,LineIndent->0],216],Right]

Why does LTCI look this way?

Why is there a right to increase prices?

Arguments for ...

LTCI a very risky product; insurers need flexibility

Let life insurers write this new product without jeopardizing existing policyholders (analogies to subsidiaries)

Insurance regulators will prevent abuse

Arguments against ...

Risk should be shared by broader pool; use conventional insolvency law

"Mutualization" should be more explicit

Insurance regulators may well not prevent abuse

Insureds can be lured in by low starter prices, see their health deteriorate and then forfeit LTCI when premiums predictably rise

Why, in contrast to many life insurance products, is there generally no cash surrender value with LTCI?

Actually illegal for "tax qualified" LTCI

Framed[Column[{"The term \"qualified long-term care insurance contract\" means any insurance contract if ... (D) such contract does not provide for a cash surrender value or other money that can be (i) paid, assigned or pledged as collateral for a loan, or (ii) borrowed ...",Style["Internal Revenue Code § 7702B(b)(1)",FontSlant->"Italic"]}],Background->Lighter[RGBColor[0.4494697489890898,0.7013504234378576,0.1671320668345159],0.5],FrameStyle->Darker[RGBColor[0.,0.5593194476234074,0.7058823529411765],0.5]]

Arguments for ...

Contingent non - forfeiture gives similar protection

Lapse finance is good

Tax reasons : Permitting cash surrender value would permit abuse by permitting policyholders to create large tax - deferred investments

Arguments against

Contingent non - forfeiture is an inadequate substitute

Lapse finance is bad

Tax justification falsely assumes that most people deduct LTCI premiums

Deliberately engineering an illiquid product is a bad idea

Using mathematics developed for life insurance to understand LTCI

Cumulative probability of death (G) is just a CDF

An animated tour of life insurance mathematics

ListAnimate[Map[Pane[Rasterize[Style[#,FontSize->24,FontFamily->"Times"]],{660,220}]&,{Labeled[TraditionalForm[((G'[t])/(1-G[t]))],"the force of the transition\nbetween life and death",Top],Labeled[TraditionalForm[Integrate[p[t](1-G[t])Exp[-r t],{t,0,τ}]],"the actuarial value of future premiums",Top],Labeled[TraditionalForm[Integrate[G'[t]Exp[-r t]s[t],{t,0,τ}]],"the actuarial value of future benefits",Top],Labeled[(((∫_0^τ)(E^(-r t)) s(t) G'(t)\[DifferentialD]t)/((∫_0^τ)(1-G(t)) (E^(-r t))\[DifferentialD]t)),"net premium",Top],Labeled[Column[{Labeled[Row[{"G[ζ,t]=",FullSimplify[G[t]/.First@DSolve[{G[ζ]==0,((G'[t])/(1-G[t]))==μ[t]},G[t],t]/.{Integrate[a_,b_,opts___]:>Integrate[a,b]}/.K[1]->t]}],"cumulative probability of death\nconditional on being alive at ζ",Bottom,Background->themeColor1],Labeled[TraditionalForm[Integrate[(1-G[ζ,t])p[t]Exp[-r (t-ζ)],{t,ζ,τ}]-Integrate[(∂_t)G[ζ,t]s[t]Exp[-r (t-ζ)],{t,ζ,τ}]],"computing the reserve using the conditional\ndeath curve",Bottom,Background->Lighter[themeColor2,0.5]]}],"direct method for computing the reserve",Top],Labeled[TraditionalForm[{(∂_t)V[t]==r V[t]+p[t]-μ[t](s[t]-V[t]),V[τ]==0}],"Thiele's Equation for computation of the reserve",Top],Labeled[TraditionalForm[Integrate[((Integrate[(Subscript[G, α])'[t]Exp[-(Subscript[r, α]) t]s[t],{t,0,τ}])/(Integrate[(1-(Subscript[G, α])[t])Exp[-r t],{t,0,τ}]))(1-(Subscript[G, ω])[t])Exp[-(Subscript[r, ω]) t],{t,0,τ}]-Integrate[(Subscript[G, ω])'[t]Exp[-(Subscript[r, ω]) t]s[t],{t,0,τ}]],"insurer profits based on anticipated (α) conditions\nversus actual (ω) experience",Top]}]]

Modeling Life Insurance with Contingent Non-Forfeiture

Recall that contingent non - forfeiture permits the insured to "choose" a new policy with zero premiums but a benefit equal to the lesser of the original benefit or accumulated premiums

Insurer profitability using repricing that does not trigger contingent non-forfeiture

Manipulate[repricingManipulate[r,incept,rt,verticalPlotRangeControl],
(* -------- controls --------*)
Column[{Control@{{incept,52,Pane["policy incepts at this age",144]},30,90,1,ImageSize->Small,Appearance->"Labeled"},
Control@{{rt,10,Pane["reprice at this maturity",144]},1,40,1,ImageSize->Small,Appearance->"Labeled"},
Control@{{r,0.06,Pane["interest rate",144]},0.01,0.12,0.01,ImageSize->Small,Appearance->"Labeled"}}],{{verticalPlotRangeControl,All,"vertical plot range option"},{All,Automatic,{-1,1},{-0.5,0.5},{-0.25,0.25}},ControlPlacement->Bottom}]

Insurer profitability using repricing that triggers contingent non-forfeiture

Manipulate[profitManipulate[{{γActual,γAnticipated},{αActual,αAnticipated},{βActual,βAnticipated}},{rActual,rAnticipated},incept,verticalPlotRangeControl],
Row[{Column[{Control@{{incept,52,Pane["policy incepts at this age",144]},30,90,1,ImageSize->Small,Appearance->"Labeled"},

Control@{{rActual,0.06,Pane["actual interest rate",144]},0.01,0.12,0.01,ImageSize->Small,Appearance->"Labeled"},Control@{{rAnticipated,0.06,Pane["anticipated interest rate",144]},0.01,0.12,0.01,ImageSize->Small,Appearance->"Labeled"}}],
OpenerView[{"mortality controls",
Grid[{{"actual value","anticipated value"},{Control@{{γActual,1,"actual γ"},0,20,1,ImageSize->Small},Control@{{γAnticipated,1,"anticipated γ"},0,20,1,ImageSize->Small}},{Control@{{αActual,1,"actual α"},0.5,1.5,0.1,ImageSize->Small},Control@{{αAnticipated,1,"anticipated α"},0.5,1.5,0.1,ImageSize->Small}},{Control@{{βActual,1,"actual β"},0.5,1.5,0.1,ImageSize->Small},Control@{{βAnticipated,1,"anticipated β"},0.5,1.5,0.1,ImageSize->Small}}},Dividers->All,Background->ColorData[1][7]]}]}],{{verticalPlotRangeControl,All,"vertical plot range option"},{All,Automatic,{-1,1},{-0.5,0.5},{-0.25,0.25}},ControlPlacement->Bottom}]

Reserves with contingent non - forfeiture triggered

Manipulate[reserveManipulate[{γ,α,β},r,incept,cnf],
(* --------- controls -----------*)
Row[{Column[{Control@{{incept,52,Pane["policy incepts at this age",144]},30,90,1,ImageSize->Small,Appearance->"Labeled"},
Control@{{cnf,10,Pane["contingent non-forfeiture at this maturity",144]},1,40,1,ImageSize->Small,Appearance->"Labeled"},
Control@{{r,0.06,Pane["interest rate",144]},0.01,0.12,0.01,ImageSize->Small,Appearance->"Labeled"}}],
OpenerView[{"mortality controls",
Column[{Control@{{γ,1,"γ mortality parameter"},0,20,1},Control@{{α,1,"α mortality parameter"},0.5,1.5,0.1},Control@{{β,1,"β morality parameter"},0.5,1.5,0.1},Column[{(*Row[{"median time of death is ",t/.medianDeathTime[myG@@Append[globalRealistic*{γ,α,β},0]]}],*)Dynamic[survivalCurve[myG@@Append[globalRealistic*{γ,α,β},0]]]}]}]}]}]]

The complications when modeling LTCI

Multiple states, not just life and death

Need to use a time inhomogeneous Markov model

A Parameterized Multistate Life Table

Life Transitions

A Health Stories Model of Long Term Care Insurance

Minimal published data on transition rates

Efforts to estimate by Robinson, Leung and others

Minimal data on lapse rates

Some data from UK and Canada

Contract much more complex in that it depends not only on current state but on state history

Row[{TreeForm[premiumDue[{"base\npremium","age\nexcuse","maturity\nexcuse",{1,2,3},{4,5,6,7},"elimination\nperiod\nexcuse","cumulative\nbenefit\nexcuse","benefit\ninflation\rate",{{20,2,0,0,0,0,1,0},1,52}},False,{"time","prem","indem","accPrem","accIndem","monthly\nbenefit","remaining\nbenefit"}],ImageSize->300],TreeForm[indemnityDue[{"base\npremium","age\nexcuse","maturity\nexcuse",{1,2,3},{4,5,6,7},"elimination\nperiod\nexcuse","cumulative\nbenefit\nexcuse","benefit\ninflation\rate",{{20,2,0,0,0,0,1,0},4,52}},False,{"time","prem","indem","accPrem","accIndem","monthly\nbenefit","remaining\nbenefit"}],ImageSize->300]}]

contractStories=FoldList[generateNewContractState[contractParameters,#1,#2]&,initialContractState,healthHistory] (* pseudo code for moving from health stories and contract parameters to contract stories*)

Project Status

Can generate thousands of health histories from transition parameters extremely fast

Can generate corresponding contract stories from contract parameters and health histories fairly fast

Parallel computing useful

Beginning to use contract stories to compute fair premiums, effects of contingent non - forfeiture

Considering regulatory reform proposals

Initialization Code

Code to model life insurance

myG=Function[{γ,α,β,incept},Evaluate[G/.First@DSolve[{G[incept]==0,G'[t]/(1-G[t])==γ+α Exp[β t]},G,t]]]

{{G[t]->-(E^(-(∫_1^ζ)-μ[K[1]]\[DifferentialD]K[1])) ((E^((∫_1^t)-μ[K[1]]\[DifferentialD]K[1]))-(E^((∫_1^ζ)-μ[K[1]]\[DifferentialD]K[1])))}}

myg=Function[{γ,α,β,incept},Evaluate@Function[t,Evaluate@D[myG[γ,α,β,incept][t],t]]]

myμ=Function[{γ,α,β,incept},Evaluate[Function[t,Evaluate[Simplify[((myg[γ,α,β,incept][t])/(1-myG[γ,α,β,incept][t]))]]]]]

globalRealistic={γ,α,β}/.FindRoot[{myG[γ,α,β,0][80]==0.5,myG[γ,α,β,0][100]==0.995,myG[γ,α,β,0][10]==0.001},{γ,0.002},{α,0.002},{β,0.06}]

breakEvenPremium[G_,r_,incept_,τ_]:=NIntegrate[Exp[-r (t-incept)]G'[t],{t,incept,τ}]/ NIntegrate[Exp[-r (t-incept)](1-G[t]),{t,incept,τ}]

profit[G_,p_,r_,incept_,cnf_,τ_]:=NIntegrate[If[t<cnf+incept,p,0]Exp[-r (t-incept)](1-G[t]),{t,incept,τ}]-NIntegrate[If[t<cnf+incept,1,Min[cnf p,1]]Exp[-r (t-incept)]G'[t],{t,incept,τ}]

multiPriceProfit[G_,p_List,r_,incept_,repricingTimes_List,τ_]:=Block[{f},
f[x_]:=Piecewise[MapThread[{#1,#2[[1]]≤x<#2[[2]]}&,{p,Partition[Join[{0},incept+repricingTimes,{∞}],2,1]}]];
NIntegrate[f[t]Exp[-r(t-incept)](1-G[t]),{t,incept,τ}]-NIntegrate[Exp[-r (t-incept)]G'[t],{t,incept,τ}]]/;Length[p]==Length[repricingTimes]+1

thieleN[p_,μ_,r_,incept_,terminalTime_,s_:1]:=(Sow[p];v/.First@NDSolve[{v[terminalTime]==0,v'[t]==p+ r v[t] -μ[t](s-v[t])},v,{t,incept,terminalTime}])

survivalCurve[G_]:=Plot[1-G[t],{t,0,105},PlotStyle->Thick,GridLines->Automatic,BaseStyle->14,Axes->False,Frame->True,FrameLabel->{"age","percent alive"},AspectRatio->1/4,ImageSize->400,ImagePadding->{{50,10},{50,10}}]

legendPrimitives[legends:{{_,_}..}]:=Framed[Style[Column[Map[Grid[{{Graphics[{GrayLevel[0.9],Directive[EdgeForm[Opacity[0.7]],First[#]],Rectangle[{0,0},{1,1}]},{ImageSize->10}],Last[#]}}]&,legends]],"TR",ShowStringCharacters->False,FontSize->16]]

columnFrameTicks[incept_,range_]:=Map[{#,Column[{#,If[#-incept≥0,#-incept,Null]}]}&,FindDivisions[Append[range,5],10]]

columnFrameTicksReversed[incept_,range_]:=Map[{#+incept,Column[{#,#+incept}]}&,FindDivisions[Append[range,5],10]]

reserveManipulate[mortalityParams:{γ_,α_,β_},r_,incept_,cnf_]:=Module[{realistic$=globalRealistic {γ,α,β},reaped$,reapedcnf$,p1$,p2$},reaped$=Reap[thieleN[breakEvenPremium[myG@@Append[realistic$,incept],r,incept,105],myμ@@Append[realistic$,incept],r,incept,105,1]];reapedcnf$=Reap[thieleN[0,myμ@@Append[realistic$,incept],r,cnf+incept,105,Min[1,reaped$[[2,1,1]] cnf]]];p1$=Plot[Tooltip[reaped$[[1]][t],"reserve without contingent non-forfeiture"],{t,incept,105},ColorFunction->(If[#1<cnf+incept,ColorData[1][1],ColorData[1][2]]&),ColorFunctionScaling->False,PlotStyle->Thick];p2$=Plot[Tooltip[If[t<cnf+incept,Null,reapedcnf$[[1]][t]],"reserve after contingent non-forfeiture"],{t,incept,105},ColorFunction->(ColorData[1][3]&),ColorFunctionScaling->False,PlotStyle->Thick];Labeled[Graphics[{p1$[[1]],p2$[[1]],{Text["incept",{incept,1},{1,1}],Text["CNF",{incept+cnf,1},{-1,1}],Dashed,ColorData[1][5],Line[{{incept,0},{incept,1}}],Dashed,ColorData[1][6],Line[{{incept+cnf,0},{incept+cnf,1}}],Black,Inset[With[{paneWidth=144},legendPrimitives[{{ColorData[1][1],Pane["reserve before CNF",paneWidth]},{ColorData[1][2],Pane["reserve with no CNF",paneWidth]},{ColorData[1][3],Pane["reserve with CNF",paneWidth]}}]],{22,0.95`},{-1,1}]}},Axes->False,Frame->True,FrameTicks->{columnFrameTicks[incept,{21,105}],Automatic,None,None},FrameLabel->{Column[{"age of insured","policy maturity"}],"reserve"},BaseStyle->18,PlotRange->{{21,105},{0,1}},AspectRatio->1/2,ImageSize->600,ImagePadding->{{50,10},{100,20}}],Style["The Effect of Contingent Non-Forfeiture on Reserves","Section"],Top]]

profitManipulate[{{γActual_,γAnticipated_},{αActual_,αAnticipated_},{βActual_,βAnticipated_}},{rActual_,rAnticipated_},incept_,verticalPlotRangeControl_]:=Labeled[Module[{actualMortalityParams$,anticipatedMortalityParams$,bep$,profitTableI$},actualMortalityParams$={γActual,αActual,βActual};anticipatedMortalityParams$={γAnticipated,αAnticipated,βAnticipated};𝒢anticipated=myG@@Append[globalRealistic anticipatedMortalityParams$,52];𝒢actual=myG@@Append[globalRealistic actualMortalityParams$,52];bep$=breakEvenPremium[𝒢anticipated,rAnticipated,52,105];profitTableI$=Interpolation[Table[{cnf+incept,profit[𝒢actual,bep$,rActual,52,cnf,105]},{cnf,0,50,5}]];Plot[profitTableI$[t],{t,incept,105},PlotStyle->Thick,Axes->{True,False},Frame->True,FrameTicks->{columnFrameTicksReversed[incept,{0,50}],Automatic,None,None},FrameLabel->{Column[{"contingent non-forfeiture time","age of insured"}],"insurer economic profit"},BaseStyle->18,PlotRange->{{21,105},verticalPlotRangeControl},AspectRatio->1/2,ImageSize->600,ImagePadding->{{90,10},{100,20}}]],Style["The Effect of Contingent Non-Forfeiture on Insurer Profits","Section"],Top]

multiPriceProfit[G_,p_List,r_,incept_,repricingTimes_List,τ_]:=Block[{f},
f[x_]:=Piecewise[MapThread[{#1,#2[[1]]≤x<#2[[2]]}&,{p,Partition[Join[{0},incept+repricingTimes,{∞}],2,1]}]];
NIntegrate[f[t]Exp[-r(t-incept)](1-G[t]),{t,incept,τ}]-NIntegrate[Exp[-r (t-incept)]G'[t],{t,incept,τ}]]/;Length[p]==Length[repricingTimes]+1

contingentNonForfeitureTrigger[x_Integer]:=Piecewise[{{2.00,x≤29},{1.90,30<=x≤34},{1.70,35≤x≤39},{1.50,40≤x≤44},{1.30,45≤x≤49},{1.10,50≤x≤54},{.90,55≤x≤59},{((310-4x)/100.),60≤x≤65},{((48-2(x-66))/100.),66≤x≤79},{((20-(x-80))/100.),80≤x≤89},{0.10,x≥90}}]

contingentNonForfeitureTrigger[x_?NumberQ]:=Mean[{contingentNonForfeitureTrigger[Floor[x]],contingentNonForfeitureTrigger[Ceiling[x]]}]

themeColor1=RGBColor[0.724734874494545, 0.8506752117189288, 0.583566033417258];

themeColor2=RGBColor[0., 0.2796597238117037, 0.35294117647058826`];

repricingManipulate[r_,incept_,rt_,verticalPlotRangeControl_]:=Labeled[Module[{netprem$=breakEvenPremium[myG@@Append[globalRealistic,incept],r,incept,105],𝒢$=myG@@Append[globalRealistic,incept],mppTable$,mppTableI$},mppTable$=Table[{p1,δ,multiPriceProfit[𝒢$,{netprem$ p1,netprem$ p1 (1+δ)},r,incept,{rt},105]},{p1,{0.25`,1,2,3}},{δ,{-0.5`,0,1,2}}];mppTableI$=Interpolation[Flatten[mppTable$,1],InterpolationOrder->2];Plot3D[mppTableI$[p1,δ],{p1,0.25`,3},{δ,-0.5`,2},AspectRatio->1/2,ImageSize->600,ImagePadding->{{90,50},{100,20}},PlotRange->{{0.25`,3},{-0.5`,2},verticalPlotRangeControl},PlotPoints->2,MaxRecursion->1,RegionFunction->(#2≤contingentNonForfeitureTrigger[incept]&),MeshFunctions->{#1&,#2&,#3&},Mesh->{{1},{0},{0}},ColorFunction->ColorData["DarkRainbow"],AxesLabel->{"pricing before","pricing\nrelative\nto before","profit    "},BaseStyle->16,Epilog->{Inset[Text[Style["before price is relative to break even premium for a statically priced policy\nafter price is relative to before price",FontSize->14,FontSlant->"Italic"]],ImageScaled[{0.9`,0.1`}],{1,0}]}]],Style["The Effect of Re-Pricing on Insurer Profits","Section"],Top]

Code to generate health stories using adjusted Robinson method

{a,b,c}={{{0.,-2.53,-5.49,-9.17,-5.18,-4.45,-9.12,-3.56},{-2.98,0.,-1.88,-3.75,-4.99,-2.72,-3.99,-2.21},{-3.87,-0.4,0.,-2.11,-1.92,-2.33,-9.21,-1.66},{-9.23,-3.28,-1.,0.,-1.12,-3.42,-1.97,-2.03},{-9.32,-5.05,-4.23,-2.4,0.,-9.22,-1.92,-1.19},{-5.37,-2.24,-1.95,-3.11,-3.51,0.,-1.34,-2.78},{-7.07,-9.23,-4.67,-9.21,-1.11,-3.02,0.,-1.1}},{{0.,-0.062,-0.062,-0.062,-0.062,-0.062,-0.062,-0.57},{-0.041,0.,-0.062,-0.062,-0.062,-0.062,-0.062,-0.57},{-0.041,-0.041,0.,-0.062,-0.062,-0.062,-0.062,-0.57},{-0.041,-0.041,-0.041,0.,-0.062,-0.062,-0.062,-0.57},{-0.041,-0.041,-0.041,-0.041,0.,-0.062,-0.062,-0.57},{-0.041,-0.041,-0.041,-0.041,-0.041,0.,-0.062,-0.57},{-0.041,-0.041,-0.041,-0.041,-0.041,-0.041,0.,-0.57}},{{0.,9.51,9.51,9.51,9.51,9.51,9.51,5.23},{-4.73,0.,3.11,3.11,3.11,3.11,3.11,3.35},{-4.73,-4.73,0.,3.11,3.11,3.11,3.11,3.35},{-4.73,-4.73,-4.73,0.,3.11,3.11,3.11,3.35},{-4.73,-4.73,-4.73,-4.73,0.,3.11,3.11,3.35},{-4.73,-4.73,-4.73,-4.73,-4.73,0.,3.11,3.35},{-4.73,-4.73,-4.73,-4.73,-4.73,-4.73,0.,3.35}}};

rijsx=Compile[{{i,_Integer},{j,_Integer},{s,_Integer},{x,_Real}},Which[And[i<8,i≠j],Exp[a[[i,j]]+b[[i,j]](s-(1/2))+((c[[i,j]](x-83))/100)],i==8,0,And[i<8,i==j],0]];(* note that I am using 83 rather than 80 in this expression, which is the number that Robinson recommends. This substitution achieves more realistic mortality results *)

r=Compile[{{s,_Integer},{x,_Real}},Module[{temp=Table[rijsx[i,j,s,x],{i,1,8},{j,1,8}]},MapIndexed[ReplacePart[#,-Total[Delete[#,#2[[1]]]],#2[[1]]]&,temp]]];

τ=Compile[{{s,_Integer},{x,_Real},{δ,_Real}},MatrixExp[δ Module[{temp=Table[rijsx[i,j,s,x],{i,1,8},{j,1,8}]},MapIndexed[ReplacePart[#,-Total[Delete[#,#2[[1]]]],#2[[1]]]&,temp]]]];

(*0 is male; 1 is female *)

𝕋0=ParallelTable[τ[0,40+i/12,1/12],{i,0,-1+80*12}]; (* starts with 40 year olds *)

𝕋1=ParallelTable[τ[1,40+i/12,1/12],{i,0,-1+80*12}];

RunLengthEncode[x_List]:={First[#],Length[#]}&/@Split[x]

RunLengthDecode[r_List]:=Flatten@Apply[ConstantArray,r,1]

DistributeDefinitions[𝕋0,𝕋1]

Timing[lives0=ParallelTable[RunLengthEncode[FoldList[RandomChoice[#2[[#1]]->Range[8]]&,1,𝕋0]],{10000}];]

Timing[lives1=ParallelTable[RunLengthEncode[FoldList[RandomChoice[#2[[#1]]->Range[8]]&,1,𝕋1]],{10000}];]

(*Put[lives0,"/Volumes/SChandler/Scholarship/LTCI/livesMale.txt"]*)

(*Put[lives1,"/Volumes/SChandler/Scholarship/LTCI/livesFemale.txt"]*)

Code for moving from health stories to contract stories

eliminationPeriodSatisfiedQ[benefitStates:{___Integer},eliminationPeriod_,cumulativeStates:{___Integer}]:=Total[Part[cumulativeStates,benefitStates]]≥eliminationPeriod

maturityExcuseQ[cumulativeStates:{___Integer},maturityExcuse_]:=Total[cumulativeStates]>=maturityExcuse

ageExcuseQ[age_,ageExcuse_]:=age≥ageExcuse

benefitsExhaustedExcuseQ[remainingBenefit_]:=remainingBenefit≤0;

premiumWaiverExcuseQ[eliminationPeriod_,benefitStates:{___Integer},cumulativeStates:{___Integer},currentState_Integer]:=MemberQ[benefitStates,currentState] && Total[Part[cumulativeStates,benefitStates]]≥eliminationPeriod

premiumDue[𝒟:{basePremium_,ageExcuse_,maturityExcuse_,statesDue:{__Integer},benefitStates:{___Integer},eliminationPeriodExcuse_,cumulativeBenefitExcuse_,benefitInflationRate_,healthTriad:{cumulativeStates:{___Integer},currentState_Integer,age_}},cnfKickIn_,ℋ:{time_,prem_,indem_,accPrem_,accIndem_,monthlyBenefit_,remainingBenefit_}]:=basePremium*Boole[And[MemberQ[statesDue,currentState] ,Not[Or[cnfKickIn,ageExcuseQ[age,ageExcuse],maturityExcuseQ[cumulativeStates,maturityExcuse],benefitsExhaustedExcuseQ[remainingBenefit],premiumWaiverExcuseQ[eliminationPeriodExcuse,benefitStates,cumulativeStates,currentState]]]]];

indemnityDue[𝒟:{basePremium_,ageExcuse_,maturityExcuse_,statesDue:{__Integer},benefitStates:{___Integer},eliminationPeriodExcuse_,cumulativeBenefitExcuse_,benefitInflationRate_,healthTriad:{cumulativeStates:{___Integer},currentState_Integer,age_}},cnfKickIn_,ℋ:{time_,prem_,indem_,accPrem_,accIndem_,monthlyBenefit_,remainingBenefit_}]:=Max[0,Min[monthlyBenefit,remainingBenefit]]*Boole[And[eliminationPeriodSatisfiedQ[benefitStates,eliminationPeriodExcuse,cumulativeStates],MemberQ[benefitStates,currentState]]]

unfolding[𝒟:{premiumFunction_,ageExcuse_,maturityExcuse_,statesDue:{__Integer},benefitStates:{___Integer},eliminationPeriodExcuse_,cumulativeBenefitExcuse_,benefitInflationRate_,healthTriad:{cumulativeStates:{___Integer},currentState_Integer,age_}},cnfKickInFunction_,δt_,ℋ:{time_,prem_,indem_,accPrem_,accIndem_,monthly_,remainingBenefit_}]:=Module[{newPremium,newIndemnity,newMonthly,newRemaining,basePrem=premiumFunction[time],cnfKickIn=cnfKickInFunction[time]},
newPremium=premiumDue[ReplacePart[𝒟,1->basePrem],cnfKickIn,ℋ];
newIndemnity=indemnityDue[ReplacePart[𝒟,1->basePrem],cnfKickIn,ℋ];
newMonthly=If[cnfKickIn,monthly,monthly(1+benefitInflationRate)];
newRemaining=Max[0,If[cnfKickIn,Clip[accPrem-newIndemnity,{0,remainingBenefit}],(remainingBenefit-newIndemnity)(1+benefitInflationRate)]];
{time+δt,newPremium,newIndemnity,accPrem+newPremium,accIndem+newIndemnity,newMonthly,newRemaining}]