#_________________________________________________4DS-

G4__________________________________________________
#___________________________Sujet 3 : Prix de rentes viagères genrés et
unisexe___________________________

#NB:
#pour chaque question on va utiliser comme entête :
#*********************************************Question"i":************************************
*********************
#pour chaque intérprétation on va utiliser ce cadre :
###################################################################
################################################
###                                                                                                                                                                 
###
###################################################################
################################################

#chargement des librairies necéssaires :

#NB=(faute de dépendance entre les packages priére de sélectionner les librairies et
faire le "run" 2 fois)

library(forecast)
library(demography)
#help(fitdistr)
library(survival)
library(npsurv)
library(lsei)
library(fitdistrplus)
library(gnm)
library(StMoMo)
library(plotly)
library(ggplot2)
library(lifecontingencies)
library(MASS)
library(pcaPP)
library(rainbow)

#*********************************************Question"1":************************************
*********************

### ---choix des fichiers--- :

#- les fichiers sont les suivants :
#-      - 1 : "Mx_1x1.txt" : Nom de fichier contenant les taux de mortalité
démographiques
#-      - 2 : "Exposures_1x1" : Nom de fichier contenant l'exposition au rique

# --- 1ére méthode : ----

#télechargement des donnés HMD :
# en utilisant la commande [Link]() : label U.K : "GBR_NP"
# [Link] : lit les données "Mx" (1x1) de la base de données sur la mortalité
humaine et construit un objet demogdata
# [Link] : lit les données "Population" (1x1) du HMD et construit un objet
demogdata
# help([Link])
DEATH = [Link]("GBR_NP", "[Link]@[Link]", "1586862810", label = "les
taux démographiques - United Kingdom")
EXPOSURE = [Link]("GBR_NP", "[Link]@[Link]", "1586862810", label
= "les numéros de population - United Kingdom")
# Warning des NAs introduits !

# --- 2éme méthode : ---- (utilisé par la suite)

# help([Link])
#chargement des donnés HMD :
# changement du dossier du travail et spécification du chemin d'accès au dossier
souhaité (contenant les fichiers a utiliser)
setwd("/Users/khemiriwissal/Desktop/Projet-Actuariat-vie-Groupe-4-4DS/Code_R ")

# construction du demogdata du U.K , et dont le type d'objet est : «mortality» (car on

va étudier des données de mortalité) :
demogUK <- [Link](file="Mx_1x1.txt",
                                                    popfile="Exposures_1x1.txt",
                                                    type="mortality", label="United Kingdom Total Population")

class(demogUK) # type 'demogdata' vérifié

names(demogUK)

# résumé
summary(demogUK)
###################################################################
################################################
###la série de mortalité pour le Royaume-Uni commence en 1922, donc nous
pouvons montrer les taux de mortalité    ###
###pour la cohorte de naissance de 1955 pour les 60 ans . Les taux de mortalité par
cohorte aux plus jeunes âges###
###sont indiqués comme manquants (notés "."). De même, la série de mortalité se
termine en 2016, nous pouvons      ###
###montrer les taux de mortalité pour la cohorte de 1955 jusqu'à 29 ans car au 60
décembre 2016,tous les membres###
###de cette cohorte ont atteint l'âge de 61 ans. Pourtant, les données de mortalité
pour 61 ans resteront              ###
###incomplètes jusqu'au 31 décembre 2017.                                                                               
###
###################################################################
################################################

# Manipulation des données HMD :

# Affichage des objets demogdata :
#### &&&&&&&&&&&&&&&&&---les ages en axe des abscisses---
&&&&&&&&&&&&&&&&& :

# graph taux de mortalité de la polpulation total en fonction de l'age :

#par(mar=c(1, 1, 1, 1 ), xpd=TRUE)
plot(demogUK, series = 'total')
## avec légendes des années   
legend("bottomright",legend=unique(demogUK$year),
              col=rainbow(length(demogUK$year)*1.25), ncol=5, pch=3,
              title="Year", cex=0.6 )
# ***ce plot exprime l'Evolution des taux de mortalité de l'ensemble de la population
de Royaume-Uni entre les
#        années 1922 a 2016 en fonction des ages"

###################################################################
################################################
### -on remarque que les taux de mortalité sont les plus élevés pour les âges
extrêmes (les nouveaux nés /            ###
###      les personnes âgés )                                                                                                                 
###
###################################################################
################################################
#---

# graph taux de mortalité de la polpulation masculine en fonction de l'age :

#par(mar=c(1, 1, 1, 1 ), xpd=TRUE)
plot(demogUK, series = 'male')
## avec légendes des années   
legend("bottomright",legend=unique(demogUK$year),
              col=rainbow(length(demogUK$year)*1.25), ncol=5, pch=3,
              title="Year", cex=0.6 )

# ***ce plot exprime l'Evolution des taux de mortalité de la polpulation masculine de

Royaume-Uni entre les
#        années 1922 a 2016 en fonction des ages"

###################################################################
################################################
###-on remarque que les taux de mortalité sont les plus élevés pour les âges
extrêmes (les nouveaux nés / les      ###
###personnes âgés )                                                                                                                               
###
###La courbe de mortalité masculine présente une courbe en double cloche, avec
un minimum, un maximum local, un ###
###minimum local et une croissance.                                                                                               
###
###Pour les hommes , on remarque une décroissance jusqu'a un niveau minimum
des ageés de 10 ans puis croissance ###
###brusque et importante des années en couleur jaune (1939-1945) ce qui est
expliqué par le décès de L'armée de ###
###terre britannique .                                                                                                                             
###
###################################################################
################################################
#---

# graph taux de mortalité de la polpulation féminine en fonction de l'age :

#par(mar=c(1, 1, 1, 1 ), xpd=TRUE)
plot(demogUK, series = 'female')
## avec légendes des années   
legend("bottomright",legend=unique(demogUK$year),
              col=rainbow(length(demogUK$year)*1.25), ncol=5, pch=3,
              title="Year", cex=0.6 )

# ***ce plot exprime l'Evolution des taux de mortalité de la polpulation féminine de

Royaume-Uni entre les
#        années 1922 a 2016 en fonction des ages"

###################################################################
################################################
### -on remarque que les taux de mortalité sont les plus élevés pour les âges
extrêmes (les nouveaux nés /            ###
###      les personnes âgés )                                                                                                                 
###
###################################################################
################################################
#---

# Affichage 'homme' VS 'femme' VS 'total' en fonction de l'age :

#par(mar=c(1, 1, 1, 1 ), xpd=TRUE)
par(mfrow=c(1,3))
plot(demogUK,series="male",datatype="rate", main="Male rates")
plot(demogUK,series="female",datatype="rate", main="Female rates")
plot(demogUK,"total",datatype="rate", main="Total rates")

# ***ce plot exprime l'Evolution des taux de mortalité de la polpulation total ,

masculine et féminine de
#        Royaume-Uni entre les années 1922 a 2016 en fonction des ages"

###################################################################
################################################
###Pour la population anglaise , ces graphes présentent    les 3 schémas du
logarithme des taux de mortalité en      ###
###fonction de lâge .                                                                                                                               
###
###On remarque plusieurs comportements , on constate que :                                             
###
###- Les femmes sont également épargnées du pic de mortalité que la courbe
rencontrée chez les hommes à la            ###
###sortie    de l'adolescence. Cela est probablement dû au fait que les normes
culturelles imposent souvent aux      ###
###hommes une tendance à prendre plus de risques pour s'affirmer à la sortie de
l'adolescence .                                  ###
###################################################################
################################################
#---

# on ensuite on veut voir les taux de mortalité pour les années extemes :
# on choisit d'utiliser la fct log pour lignariser nos graphics ==> type='l'

# pour l'année 1922 :

plot(demogUK$age, log(demogUK$rate$total[,"1922"]), main ='log mortality rates
(demoUK, 1922)',
          xlab = "Ages x", ylab = "log mortality rates", type = "l")

# ***ce plot exprime l'Evolution des taux de mortalité de des individus de générations
différentes regroupés par age
#        du Royaume-Uni pendant l'année 1922 en fonction des ages"

###################################################################
################################################
### on remarque que les taux de mortalité sont les plus élevés pour les âges
extrêmes (les nouveaux nés /              ###
### les personnes âgés ) avec une croissance rapide a partir 30                                         
###
###################################################################
################################################

# pour l'année 2016 :

plot(demogUK$age, log(demogUK$rate$total[,"2016"]), main ='log mortality rates
(demoUK, 2016)',
          xlab = "Ages x", ylab = "log mortality rates", type = "l")

# ***ce plot exprime l'Evolution des taux de mortalité de des individus de générations
différentes regroupés par age
#        du Royaume-Uni pendant l'année 2016 en fonction des ages"

###################################################################
################################################
### on remarque que les taux de mortalité sont les plus élevés pour les âges
extrêmes (les nouveaux nés /              ###
### les personnes âgés ) avec une croissance rapide a partir 30                                         
###
###################################################################
################################################

# taux de mortalité pendant la 2éme guerre mondiale () :

UK_years = c(1939:1945)
plot(demogUK, series = 'total', years = UK_years ,
          main = "demoUKtotal death rates for year 1939 to 1945"
)
legend(x="bottomright", legend = UK_years,
              col = rainbow(length(UK_years)*1.25),
              lty = 1,
              cex=0.7,
              [Link] = 0.3
)

# taux de mortalité entre les années 1955 au 2015 :

UK_years = c(1955:2015)
par(mar=c(1, 1, 1, 1 ), xpd=TRUE)
plot(demogUK, series = 'total', years = UK_years ,
          main = "demoUKtotal death rates from 1955 to 2015"
)
colfunc <- colorRampPalette(c("red", "blue"))
legend(legend=unique(demogUK$year),
              col=colfunc(20), ncol=5, pch=19,
              title="Year", cex=0.6, "bottomright")

#### &&&&&&&&&&&&&&&&&---les années en axe des abscisses---

&&&&&&&&&&&&&&&&& :

# graph taux de mortalité de la polpulation totale en fonction des années :

plot(demogUK,"total",datatype="rate", main="Total
rates",[Link]="time",xlab="Years")

# ***ce plot exprime l'Evolution des taux de mortalité de la polpulation total   

#        du Royaume-Uni entre les ages 0 a 110 en fonction des années"

###################################################################
################################################
###- on remarque que les taux de mortalité sont les plus élevés pour les personnes
âgés : colorés en mauve et      ###
###en bleu (au dessus) > 84 ans ,              ainsi que les nouveaux nées entre 0 et 3
ans , qui diminue au cours de    ###
###années                                                                                                                                                   
###
###- on remarque que les taux de mortalité sont les moins élevés pour les
personnes jeunes : colorés en orangé    ###
###(au dessous) ente 20 ans et 24 ans qui diminue au cours des années .                     
###
###################################################################
################################################

# graph taux de mortalité de la polpulation masculine en fonction des années :

plot(demogUK,series="male",datatype="rate", [Link]="time", main="Male
rates",xlab="Years")

# ***ce plot exprime l'Evolution des taux de mortalité de la polpulation masculine   

#        du Royaume-Uni entre les ages 0 a 110 en fonction des années"

###################################################################
################################################
###- on remarque que les taux de mortalité sont les plus élevés pour les personnes
âgés : colorés en mauve et      ###
###en bleu (au dessus) > 84 ans ,              ainsi que les nouveaux nées entre 0 et 3
ans , qui diminue au cours de    ###
###années                                                                                                                                                   
###
###- on remarque que les taux de mortalité sont les moins élevés pour les
personnes jeunes : colorés en orangé    ###
###(au dessous) ente 20 ans et 24 ans qui diminue au cours des années .                     
###
###################################################################
################################################

# graph taux de mortalité de la polpulation féminine en fonction des années :

plot(demogUK,series="female",datatype="rate", main="Female
rates",[Link]="time",xlab="Years")

# ***ce plot exprime l'Evolution des taux de mortalité de la polpulation féminine   

#        du Royaume-Uni entre les ages 0 a 110 en fonction des années"

###################################################################
################################################
###- on remarque que les taux de mortalité sont les plus élevés pour les personnes
âgés : colorés en mauve et      ###
###en bleu (au dessus) > 84 ans ,              ainsi que les nouveaux nées entre 0 et 3
ans , qui diminue au cours de    ###
###années                                                                                                                                                   
###
###- on remarque que les taux de mortalité sont les moins élevés pour les
personnes jeunes : colorés en orangé    ###
###(au dessous) ente 20 ans et 24 ans qui diminue au cours des années .                     
###
###################################################################
################################################

#### &&&&&&&&&&&&&&&&&---les années et les ages sur les axes---

&&&&&&&&&&&&&&&&& :
# Le log des taux de mortalité en fonction de l'âge et en fonction des années en 3D :

demogUKlog = [Link](log(demogUK$rate$total))
demogUKlog[[Link](demogUKlog)]<-NA
library(ggplot2)
library(plotly)
p <- plot_ly(z = ~demogUKlog ) %>% add_surface()
p

# ***ce plot exprime l'Evolution des taux de mortalité de la polpulation féminine   

#        du Royaume-Uni en fonction des ages et des années"
###################################################################
################################################
###cette visualisation 3D représente mieux la différence entre les mortalités des
différentes années de naissance##
###################################################################
################################################

#*********************************************Question"2":************************************
*********************

cohort <- function(year, rates, log=FALSE)

{
    xg <- diag(rates[, colnames(rates) >= year])
    names(xg) <- paste(year, rownames(rates)[1:length(xg)], sep="-x=")
    if(log)
        xg <- log(xg)
    xg
}

cohort_of_cohorts <- function(years, rates, log=FALSE)

{
    xgs<-vector()
    for (year in years)
  {
        xg <- diag(rates[, colnames(rates) >= year])
        names(xg) <- paste(year, rownames(rates)[1:length(xg)], sep="-x=")
        if(log)
            xg <- log(xg)
        xgs<-c(xgs,list(xg))
  }
    xgs
}

# Cohortes sur l'ensemble des années :

colfunc <- colorRampPalette(c("red", "blue"))

cohorts<-cohort_of_cohorts(demogUK$year, demogUK$rate$total,    log=T)

plot(cohort(demogUK$year[1], demogUK$rate$total,
log=T),col=colfunc(length(demogUK$year))[1], type="l", ylim=c(-11,5), main="UK:
Cohortes")
i<-2
for (one_cohort in cohorts){
    lines (one_cohort, col=colfunc(length(demogUK$year))[i])
    i<-i+1
}
legend(legend=unique(demogUK$year),
              col=colfunc(20), ncol=5, pch=19,
              title="Year", cex=0.5, "bottomright")

# ***ce plot exprime l'Evolution des taux de mortalité de la Cohortes plutot cohorte
des cohortes    "

# 1ére Cohorte : 60% de femmes nées en 1955 ayant contractés un contrat en

2015 :

plot(cohort(1955, demogUK$rate$female, log=T),

          col=colfunc(length(1955)),
          type="l",
          ylim=c(-11,5),
          main="UK: Cohortes",
          xlab = "age",
          ylab = "Taux de Mortalité")

# ***ce plot exprime l'Evolution des taux de mortalité de la 1ére Cohorte    "
#---

cohort1955_f <- cohort(1955, demogUK$rate$female, log=F)

plot(demogUK$age, log(demogUK$rate$female[,"1955"]), main ='log mortality rates

(UK_female, 1955)',
          xlab = "Ages x", ylab = "log mortality rates", type = "l")

lines(0:(length(cohort1955_f)-1), log(cohort1955_f), main ='log mortality rates (UK,

1955)',
            xlab = "Ages x", ylab = "log mortality rates", type = "l",col='red')

legend(-4, -0.5,legend = c("Lecture longitudinale", "Lecture cohorte"),

              col=c("black","red"),lty = 1, cex=0.7,
              [Link] = 0
)

# ***ce plot exprime l'Evolution des taux de mortalité de la 1ére Cohorte    + vue
longitudinale

#-------------------------------------------------------------------------------------
# 2éme Cohorte : 40% de hommes nées en 1955 ayant contractés un contrat en
2015 :

plot(cohort(1955, demogUK$rate$male, log=T),

          col=colfunc(length(1955)),
          type="l",
          ylim=c(-11,5),
          main="UK: Cohortes",
          xlab = "age",
          ylab = "Taux de Mortalité")

# ***ce plot exprime l'Evolution des taux de mortalité de la 2éme Cohorte    "
#---
plot(cohort(1955, demogUK$rate$male, log=T),
          col=colfunc(length(1955)),
          type="l",
          ylim=c(-11,5),
          main="UK: Cohorte 2",
          xlab = "age",
          ylab = "Taux de Mortalité")

# ***ce plot exprime l'Evolution des taux de mortalité de la 2éme Cohorte + vue
longitudinale "

cohort1955_m <- cohort(1955, demogUK$rate$male, log=F)

plot(demogUK$age, log(demogUK$rate$male[,"1955"]), main ='log mortality rates

(UK_male, 1955)',
          xlab = "Ages x", ylab = "log mortality rates", type = "l")

lines(0:(length(cohort1955_m)-1), log(cohort1955_m), main ='log mortality rates (UK,

1955)',
            xlab = "Ages x", ylab = "log mortality rates", type = "l",col='red')

legend(-4, -0.5,legend = c("Lecture longitudinale", "Lecture cohorte"),

              col=c("black","red"),lty = 1, cex=0.7,
              [Link] = 0
)

# ***ce plot exprime l'Evolution des taux de mortalité de la 2éme Cohorte    + vue
longitudinale

########################## 1ére tentative : intervalle de confiance : Réf : cours

Monte Carlo :

[Link]<-fitdist(cohort(1955, demogUK$rate$total, log=T), "norm" )

[Link]$estimate

plot([Link])

# - NB : Niveau de confiance de 95% ===> z(alpha/2)=1.96

ect = [Link]$estimate["sd"]
moy_emp = [Link]$estimate["mean"]
IC_inf = moy_emp-1.96*ect/sqrt(2)
IC_sup = moy_emp+1.96*ect/sqrt(2)
plot(cohort(1955, demogUK$rate$total, log=T),
          col=colfunc(length(1955)),
          type="l",
          ylim=c(-11,5),
          main="UK: Cohorte 1",
          xlab = "age",
          ylab = "Taux de Mortalité")

abline(h=moy_emp,col="blue", lwd=3, lty=2)

abline(h=IC_inf,col="green", lwd=3, lty=2)
abline(h=IC_sup,col="green", lwd=3, lty=2)

########################## 2éme tentative : intervalle de confiance :

Réf:"[Link] :

DEATH = [Link](file="Mx_1x1.txt", header = TRUE,skip = 1, sep = "", dec = ".")

EXPOSURE = [Link](file="Exposures_1x1.txt", header = TRUE,skip = 1, sep =
"", dec = ".")

DEATH$Age=[Link]([Link](DEATH$Age))
DEATH$Age[[Link](DEATH$Age)]=110

EXPOSURE$Age=[Link]([Link](EXPOSURE$Age))
EXPOSURE$Age[[Link](EXPOSURE$Age)]=110

x=[Link](DEATH[,3:5])
y=[Link](EXPOSURE[,3:5])
ANNEE = c(1922:2016)
AGE = c(0:110)
MU=[Link](x/y,[Link] =(DEATH[,3:5])$rownames )
MUT=matrix(MU[,3],length(AGE),length(ANNEE))
persp(AGE[1:100],ANNEE,log(MUT[1:100,]),theta=-30,col="light
green",shade=TRUE)
#---
#YEAR=unique(DEATH['Year'])
YEAR = c(1922:2016)
nC=length(YEAR)

AGE =unique(DEATH$Age)
nL=length(AGE)

x=c(DEATH$Female)
y=c(EXPOSURE$Female)

MUF =matrix(x/y,nL,nC)

a=c(DEATH$Male)
b=c(EXPOSURE$Male)
MUH = matrix(a/b,nL,nC)

rownames(MUH)=AGE
colnames(MUH)=YEAR
rownames(MUF)=AGE
colnames(MUF)=YEAR

MUH=MUH[1:90,]
MUF=MUF[1:90,]

MUHF=fts(x = AGE[1:90], y = log(MUH), xname = "Age",yname = "Log Mortality

Rate")
MUFF=fts(x = AGE[1:90], y = log(MUF), xname = "Age",yname = "Log Mortality
Rate")

fboxplot(data = MUHF, [Link] = "functional", type = "bag")

fboxplot(data = MUHF, [Link] = "bivariate", type = "bag")

###################################################################
################################################
#### les années c(1940:1946) sont en dehors de l'inervalle de confiance entre les
ages c(17:40)                                  ###
###################################################################
################################################

#*********************************************Question"3":************************************
*********************

par(mfrow=c(1,1))
UK_ages = c(0,10,20,30,40,50,60,70,80,90)

plot(demogUK,
          series="total",
          datatype="rate",
          [Link]="time",
          age = UK_ages,
          main="total death rates (1922 - 2016) ",axes = F)
# on fixe les axes comme suit :
axis(side = 1, at=1922:2016)
axis(side = 2, at=-9:-1)
legend(x="bottomright", legend = UK_ages,
              col = rainbow(length(UK_ages)*1.25), lty = 1, cex=0.6,
              [Link] = 0.3)

# ***ce plot exprime l'Evolution des taux de mortalité au cours des années
###################################################################
################################################
###le comportement des taux de mortalité reste constants durants toutes les années
on va prendre enconsidération###
### toutes les années : 1922 -to- 2016    ,t ??? [1922, 2013]                                                 
###
###################################################################
################################################
#---

# Choix de la plage d'âges:

x <- demogUK$age[0:110]

plot(x, demogUK$rate$total[0:110,"1922"],
          type='l',
          col='red',
          xlab= "Ages x",
          ylab="volatility",
          ylim=c(0,1.5),
          main ="Death rates volatility (1922,2016)")

lines(x, demogUK$rate$total[0:110,"1922"], type = 'l', col="green" )

lines(x, demogUK$rate$total[0:110,"1942"], type = 'l', col='orange' )
lines(x, demogUK$rate$total[0:110,"1952"], type = 'l', col="blue" )
lines(x, demogUK$rate$total[0:110,"1962"], type = 'l', col="green" )
lines(x, demogUK$rate$total[0:110,"1972"], type = 'l', col='orange' )
lines(x, demogUK$rate$total[0:110,"1982"], type = 'l', col="blue" )
lines(x, demogUK$rate$total[0:110,"1992"], type = 'l', col="green" )
lines(x, demogUK$rate$total[0:110,"2002"], type = 'l', col='orange' )
lines(x, demogUK$rate$total[0:110,"2012"], type = 'l', col="blue" )
lines(x, demogUK$rate$total[0:110,"2016"], type = 'l', col="blue" )

legend(x="topleft",
              legend =
c("1922","1942","1952","1962","1972","1982","1992","2002","2012","2016"),
              col = c("red","green","orange","blue"),
              lty = 1,
              cex=0.6,
              [Link] = 0.3)

# ***ce plot exprime la volatilité des taux de mortalité

###################################################################
################################################
###faute d'une forte variabilité des taux de mortalité pour les âges > 100 on va se
limiter à choisir x ??? [0, 100]#
###################################################################
################################################
#---

# Lissage :
## 1- Spline monotone :
demogUK_ls_m <- [Link](demogUK,method="mspline")
## 2- Spline standard :
demogUK_ls_s <- [Link](demogUK, method="spline")
## 3- Spline Concave :
demogUK_ls_c <- [Link](demogUK, method="cspline")
## 4- Spline localement quadratique :
demogUK_ls_q <- [Link](demogUK, method="loess")

# comparaison :
plot(demogUK, years=2015, type="p", pch=21, ylim=c(-12, -2), main="UK: MT 2015 -
Lissage")
lines(demogUK_ls_m, years=2015, lty=1, col="blue")
lines(demogUK_ls_s, years=2015, lty=2, col="red")
lines(demogUK_ls_c, years=2015, lty=3, col="green")
lines(demogUK_ls_q, years=2015, lty=4, col="black")
legend("topleft",col=c("blue","red","green","black") ,lty=1:4, leg=c("mspline",
"spline","cspline","loess"))

# ***ce plot montre les 4 types de lissages utilisés ci-dessus

###################################################################
################################################
###- ===> mspline (lissage monotone) représente le mieux la variation du taux de
mortalité                                            ###
###################################################################
################################################
#---

# préparation model
#############################
#plage d'âges
[Link] = 0:100
#période de calibration
[Link] = 1922:2016
#############################

# fitting Lee Carter model :

# séparation des jeux de données totaux, hommes et femmes :
[Link] <- lca(demogUK_ls_m, series="total", adjust="dt",years =[Link] ,ages =
[Link])
[Link] <- lca(demogUK_ls_m, series="male", adjust="dt",years =[Link] ,ages =
[Link])
[Link] <- lca(demogUK_ls_m, series="female", adjust="dt",years =[Link] ,ages
= [Link])
# Paramètre ax:
plot([Link]$ax, main="Coef. ax sur données britanniques", xlab="Age",
ylab="ax", type="l")
lines(x=[Link]$age, y=[Link]$ax, main="ax", lty=2)
legend("bottomright", c("Female","Male"), cex=0.8,    lty=1:2)

###################################################################
################################################
###- Ce paramètre    ax    représente la tendance liée à l'effet isolé de l'âge sur les
taux de mortalité(moyenne      ###
###temporelle du logarithme du taux de mortalité par âge). Les courbes de    ax   
suivent la tendance des courbes    ###
###des données empiriques. Les âges faibles ont une décroissance jusqu'à
atteindre un minimum absolu à de l'âge ###
###de 12 ans, puis une croissance exponentielle a partir de l'age de 60 ans                   
###
###################################################################
################################################
#---

# Paramètre bx:
plot([Link]$bx, main="Coef. bx sur données britanniques",
ylim=c(0,0.03),xlab="Age", ylab="bx", type="l")
lines(x=[Link]$age, y=[Link]$bx, main="ax", lty=2)
legend("topright",c("Female","Male"), cex=0.8,    lty=1:2)

###################################################################
################################################
###- Le paramètre    bx    représentent l'interaction de l'effet des années calendaires
sur les taux de mortalité.    ###
###Cet effet est toujours positif          mais la valeur ne cesse de diminuer avec l'âge.
Autrement dit, l'effet des###
###années calendaires agit majoritairement avant 50 ans et de moins      en moins
au delà. On constate une bosse à ###
###22 ans et une bosse plus légère à 68 ans. Pour des âges élevés, l'effet est
quasi-inexistant puisque    bx est ###
###presque nul. C'est explicable grâce au fait que l'amélioration des conditions de
vie et de la médecine ont      ###
###diminué largement la mortalité infantile. De plus, chez les hommes, l'année a un
plus grand effet que chez      ###
###les femmes.                                                                                                                                         
###
###################################################################
################################################
#---

# Ecart absolu des coefficients :

plot([Link]$[Link]$ax, main="Ecart avec population totale", xlab="Age x",
ylab=expression(paste(Delta, " ax")), type="l" , col='green')
lines(x=[Link]$age, y=[Link]$[Link]$ax, main="delta", lty=2 , col ="blue")
legend("topright",c("Female","Male"), cex=0.8, lty=1:2)

###################################################################
################################################
###- On constate un plus grand écart de mortalité chez les femmes entre 20 et 30
ans que chez les hommes jusqu'à###
###l'âge de 70 ans. La tendance s'inverse puisqu'au delà, l'écart de mortalité est
plus grand pour les hommes.    ###
###################################################################
################################################
#---

# Paramètre Kt :
plot([Link]$kt, xlab="Year", main="Coef. kt sur données britanniques",ylab="kt",
type="l",ylim=c(-100, 100))
lines([Link]$year, y=[Link]$kt, main="kt", lty=2 , col="blue")
lines([Link]$year, y=[Link]$kt, main="kt", lty=2 , col ="red")
legend("topright", c("Male","Female"), cex=0.8, lty=1:2)

###################################################################
################################################
###- La valeur    $k_t$ illustre la diminution des taux de mortalité au fil des années
est en chute constante.        ###
###On remarque un pic de la valeur de kt autour de la deuxième guerre mondiale.     
###
###################################################################
################################################
#---

###
#étude résiduelle :
#total
plot([Link]$residuals)
#male
plot([Link]$residuals)
#female
plot([Link]$residuals)

###################################################################
################################################
###                                                                            - intérprétation des résidus :                             
###
###On constate que la variance n'est plus stable pour les ages a partir de 0 à 60 ans
et est inférieur à 0.5        ###
###le modéle ne semble pas adapté à la description des taux de mortalité des agés
moins de 60 ans.                            ###
###################################################################
################################################
#---

# Model de Lee Carter en utilisant le package """StMoMo"""

# pour les paramétres éstimés on a les memes intérprétations

#________________population totale________________ :

[Link].t<-StMoMoData(data=demogUK_ls_m ,series = "total",type="central")

#ajustement du model (fitiing) :
LC1 <- lc(link = "logit" )
LCfit1 <- fit(LC1, data = central2initial([Link].t), [Link] = [Link],    [Link] =
[Link])

names(LCfit1)
# paramétre ax :
plot(LCfit1$ax,type='l')
# paramétre bx :
plot(LCfit1$bx,type='l')
# paramétre kt :
plot(LCfit1$years,LCfit1$kt,type='l')

# analyse desidusLelles :
LCres1 <- residuals(LCfit1)
plot(LCres1,type = "scatter") # Scatter plots of deviance residuals for models LC

#________________population masculine________________ :

[Link].m<-StMoMoData(data=demogUK_ls_m ,series = "male",type="central")

#ajustement du model (fitiing) :
LC2 <- lc(link = "logit" )
LCfit2 <- fit(LC2, data = central2initial([Link].m), [Link] = [Link],    [Link] =
[Link])

names(LCfit2)
# paramétre ax :
plot(LCfit2$ax,type='l')
# paramétre bx :
plot(LCfit2$bx,type='l')
# paramétre kt :
plot(LCfit2$years,LCfit2$kt,type='l')

# analyse desidusLelles :
LCres2 <- residuals(LCfit2)
plot(LCres2,type = "scatter") # Scatter plots of deviance residuals for models LC
#________________population féminine________________ :

[Link].f<-StMoMoData(data=demogUK_ls_m ,series = "female",type="central")

#ajustement du model (fitiing) :
LC3 <- lc(link = "logit" )
LCfit3 <- fit(LC3, data = central2initial([Link].f), [Link] = [Link],    [Link] =
[Link])

names(LCfit3)
# paramétre ax :
plot(LCfit3$ax,type='l')
# paramétre bx :
plot(LCfit3$bx,type='l')
# paramétre kt :
plot(LCfit3$years,LCfit3$kt,type='l')

# analyse desidusLelles :
LCres3 <- residuals(LCfit3)
plot(LCres3,type = "scatter") # Scatter plots of deviance residuals for models LC

#*********************************************Question"4":************************************
*********************
# Affichage des log taux de mortalités historiques des femmes :
plot(extractCohort(fitted(LCfit3),age=60,period=2015),
          type="l",ylim=c(-11,-4),
          main="U.K: Comparaison cohorte femme Q1 et Q4",xlab="age")

lines(cohort(1955, (demogUK$rate$female), log=T),

            col="red",
            type="l",
            ylim=c(-11,5),
            xlab = "age",
            ylab = "Taux de Mortalité")

###################################################################
################################################
#### en utilisant de la fonction extractCohort, ona remarque que l'affichage des log
taux de mortalités                  ###
### historiques semble aux taux estimés en question 1.                                                         
###
###################################################################
################################################
#---

# Affichage des log taux de mortalités historiques des hommes :

plot(extractCohort(fitted(LCfit2),age=60,period=2015),
          type="l",ylim=c(-11,-4),
          main="U.K: Comparaison cohorte homme Q1 et Q4",
          xlab="age")
lines(cohort(1955, (demogUK$rate$male), log=T),
            col="red",
            type="l",
            ylim=c(-11,5),
            xlab = "age",
            ylab = "Taux de Mortalité")

###################################################################
################################################
#### en utilisant de la fonction extractCohort, ona remarque que l'affichage des log
taux de mortalités                  ###
### historiques semble aux taux estimés en question 1.                                                         
###
###################################################################
################################################
#---

#*********************************************Question"5":************************************
*********************

#________________population totale________________ :
horizon=25
LCfor.t <- forecast(LCfit1, h = horizon)
plot(LCfor.t)

rates.t<-cbind(demogUK$rate$total[0:100,],LCfor.t$rate[0:100,])

# projection centrale (moyenne) sur 25 ans des taux de mortalité :

plot(seq(min(demogUK$year),max(demogUK$year)+horizon),
          rates.t[60,],
          xlab="Years",
          ylab="Death Rates",
          type="l",
          main="Taux observés et projetés à un horizon de 25 ans pour x = 60 ans")

abline(v = 2017 , col="red" ,lwd=3, lty=2)

#Simulation pour vérifier

nsims=100
LCsim1 <- simulate(LCfit1, nsim = nsims, h = horizon)

plot(LCfit1$years, LCfit1$kt[1, ], xlim = range(LCfit1$years, LCsim1$kt.s$years), ylim

= range(LCfit1$kt, LCsim1$kt.s$sim[1, , 1:20]),type = "l", xlab = "year", ylab = "kt",
main = "LC model simulations")
matlines(LCsim1$kt.s$years, LCsim1$kt.s$sim[1, , 1:20], type = "l", lty = 1)

#________________population masculine________________ :
horizon=25
LCfor.m <- forecast(LCfit2, h = horizon)
plot(LCfor.m)

rates.m<-cbind(demogUK$rate$male[0:100,],LCfor.m$rate[0:100,])

# projection centrale (moyenne) sur 25 ans des taux de mortalité :

plot(seq(min(demogUK$year),max(demogUK$year)+horizon),
          rates.m[60,],
          xlab="Years",
          ylab="Death Rates",
          type="l",
          main="Taux observés et projetés à un horizon de 25 ans pour x = 60 ans")

abline(v = 2017 , col="red" ,lwd=3, lty=2)

#Simulation pour vérifier

nsims=100
LCsim2 <- simulate(LCfit2, nsim = nsims, h = horizon)

plot(LCfit2$years, LCfit2$kt[1, ], xlim = range(LCfit2$years, LCsim2$kt.s$years), ylim

= range(LCfit2$kt, LCsim2$kt.s$sim[1, , 1:20]),type = "l", xlab = "year", ylab = "kt",
main = "LC model simulations")
matlines(LCsim2$kt.s$years, LCsim2$kt.s$sim[1, , 1:20], type = "l", lty = 1)

#________________population féminine________________ :
horizon=25
LCfor.f <- forecast(LCfit3, h = horizon)
plot(LCfor.f)

rates.f<-cbind(demogUK$rate$female[0:100,],LCfor.f$rate[0:100,])

# projection centrale (moyenne) sur 25 ans des taux de mortalité :

plot(seq(min(demogUK$year),max(demogUK$year)+horizon),
          rates.f[60,],
          xlab="Years",
          ylab="Death Rates",
          type="l",
          main="Taux observés et projetés à un horizon de 25 ans pour x = 60 ans")

abline(v = 2017 , col="red" ,lwd=3, lty=2)

#Simulation pour vérifier

nsims=100
LCsim3 <- simulate(LCfit3, nsim = nsims, h = horizon)

plot(LCfit3$years, LCfit3$kt[1, ], xlim = range(LCfit3$years, LCsim3$kt.s$years), ylim

= range(LCfit3$kt, LCsim3$kt.s$sim[1, , 1:20]),type = "l", xlab = "year", ylab = "kt",
main = "LC model simulations")
matlines(LCsim3$kt.s$years, LCsim3$kt.s$sim[1, , 1:20], type = "l", lty = 1)

###################################################################
################################################
###La projection centrale est une estimation moyenne sur 25 ans des taux de
mortalité. Cette quantité peut            ###
###donner une idée sur la projection totale.                                                                                 
###
###################################################################
################################################

#*********************************************Question"6":************************************
*********************

# Affichage des log taux de mortalités historiques et projetés pour les deux cohortes,
à partir de 2005 :
#________________population totale________________ :
#plotting historical fitted rates, until max([Link]) =2015
chosen_cohort=2005                  #doit appartenir aux years de LCfit
plot(0:11, extractCohort(fitted(LCfit1, type = "rates"),    #x = 0: max([Link])-
chosen_cohort
                                                  cohort = chosen_cohort),
          type = "l", log = "y", xlab = "age", ylab = "q(x)",
          main = paste(c("Cohort",toString(chosen_cohort),"mortality rates"), collapse = "
"),
          xlim = c(0,103), ylim = c(0.000005, 0.007))

#adding fitted projections

lines(12:36, extractCohort(LCfor.t$rates, cohort = chosen_cohort), # x = l'âge
suivant:max([Link])+h - chosen_cohort
            lty = 2, lwd=2, col="red")

#________________1ére chorte : hommes nées en 2005________________ :

#plotting historical fitted rates, until max([Link]) =2015
chosen_cohort=2005                  #doit appartenir aux years de LCfit
plot(0:11, extractCohort(fitted(LCfit2, type = "rates"),    #x = 0: max([Link])-
chosen_cohort
                                                  cohort = chosen_cohort),
          type = "l", log = "y", xlab = "age", ylab = "q(x)",
          main = paste(c("Cohort",toString(chosen_cohort),"mortality rates"), collapse = "
"),
          xlim = c(0,103), ylim = c(0.000005, 0.007))

#adding fitted projections

lines(12:36, extractCohort(LCfor.m$rates, cohort = chosen_cohort), # x = l'âge
suivant:max([Link])+h - chosen_cohort
            lty = 2, lwd=2, col="red")
#________________1ére chorte : femmes nées en 2005________________ :

#plotting historical fitted rates, until max([Link]) =2015

chosen_cohort=2005                  #doit appartenir aux years de LCfit
plot(0:11, extractCohort(fitted(LCfit3, type = "rates"),    #x = 0: max([Link])-
chosen_cohort
                                                  cohort = chosen_cohort),
          type = "l", log = "y", xlab = "age", ylab = "q(x)",
          main = paste(c("Cohort",toString(chosen_cohort),"mortality rates"), collapse = "
"),
          xlim = c(0,103), ylim = c(0.000005, 0.007))

#adding fitted projections

lines(12:36, extractCohort(LCfor.f$rates, cohort = chosen_cohort), # x = l'âge
suivant:max([Link])+h - chosen_cohort
            lty = 2, lwd=2, col="red")

###################################################################
################################################
### On remaque que les log taux de mortalités historiques et projetés avec le
modéle de Lee Carter refléte            ###
### réellement la vrai vie d'un individus    sans avoir recours a des evénements    qui
vont perturber cet résultat ###
###################################################################
################################################

#*********************************************Question"7":************************************
*********************

#&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&---NB---
&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&:
#- NB : Dans cette partie pour calculer les valeurs actuelles probables , on doit
construire alors des tables
#          "actuarielles (actuarial tables) c'est pourquoi    à partir de      cette question, on
va optez a l'extraction
#            directe de deux colonnes "age" et "lx" des a partir Tables de survie(Life
tables) des fichiers suivants :
###- "bltper_1x1.txt" : United Kingdom, Life tables (period 1x1), Total
###- "mltper_1x1.txt" : United Kingdom, Life tables (period 1x1), Males
###- "fltper_1x1.txt" : United Kingdom, Life tables (period 1x1), Females
#&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&:

### male :
MaleUK<-[Link](file="mltper_1x1.txt", header = TRUE,skip = 1, sep = "", dec =
".")
MaleUK15_16<-MaleUK[which(MaleUK$Year == 2015),names(MaleUK)]
df_m<-[Link](MaleUK15_16)
x_m<-df_m$Age
lx_m<-df_m$lx

# transformation de la lifetable en table actuarielle :

tb_act_m <-new("actuarialtable",x=x_m,lx=lx_m,name="UK_male") # interest=3/100
par defaut

library(lifecontingencies)

#espérance de vie pour l'age 60 :

ESP_m=exn(tb_act_m,x=60)
#probabilité de survie pour l'age 60 jusqu'a la fin du contrat :
P_Survie_m=pxt(tb_act_m,x=60, t=30)
#probabilité de décès pour l'age 60 jusqu'a la fin du contrat :
P_deces_m=qxt(tb_act_m,x=60, t=30)

# vap :
VAP_m = axn(tb_act_m, x=60, n=30)

#Prime pure : (exigence question suivante)

Prime_Pure_m=axn(tb_act_m, x=60, m=30)/axn(tb_act_m, x=60, m=1,n=30)
Prime_Pure_m

#---

# Female :
FemaleUK<-[Link](file="fltper_1x1.txt", header = TRUE,skip = 1, sep = "", dec =
".")
FemaleUK15_16<-FemaleUK[which(FemaleUK$Year == 2015),names(FemaleUK)]
df_f<-[Link](FemaleUK15_16)

x_f<-df_f$Age
lx_f<-df_f$lx

# transformation de la lifetable en table actuarielle :

tb_act_f <-new("actuarialtable",x=x_f,lx=lx_f,name="UK_female") # interest=3/100
par defaut

#espérance de vie pour l'age 60 :

ESP_f=exn(tb_act_f,x=60)
#probabilité de survie pour l'age 60 jusqu'a la fin du contrat :
P_Survie_f=pxt(tb_act_f, x=60, t=30)
#probabilité de décès pour l'age 60 jusqu'a la fin du contrat :
P_deces_f=qxt(tb_act_f, x=60, t=30)

# vap :
VAP_f = axn(tb_act_f, x=60, n=30)

#Prime pure : (exigence question suivante)

Prime_Pure_f=axn(tb_act_f, x=60, m=30)/axn(tb_act_f, x=60, m=1,n=30)
Prime_Pure_f

# observation :
c(VAP_m,VAP_f)
###################################################################
################################################
### on observe que la valeur actuelle probable selon que l'assuré est un homme est
inférieur à la valeur                ###
###actuelle probable selon que l'assuré est une femme                                                           
###
###################################################################
################################################

#*********************************************Question"8":************************************
*********************

# Total :
TotalUK<-[Link](file="bltper_1x1.txt", header = TRUE,skip = 1, sep = "", dec =
".")
TotalUK15_16<-TotalUK[which(TotalUK$Year == 2015),names(TotalUK)]
df_t<-[Link](TotalUK15_16)

x_t<-df_t$Age
lx_t<-df_t$lx

# transformation de la lifetable en table actuarielle :

tb_act_t <- new("actuarialtable",x=x_t,lx=lx_t,name="UK_total") # interest=3/100 par
defaut

#espérance de vie pour l'age 60 :

ESP_t=exn(tb_act_t,x=60)
#probabilité de survie pour l'age 60 jusqu'a la fin du contrat :
P_Survie_t=pxt(tb_act_t, x=60, t=30)
#probabilité de décès pour l'age 60 jusqu'a la fin du contrat :
P_deces_t=qxt(tb_act_t, x=60, t=30)

# vap :
VAP_t = axn(tb_act_t, x=60, n=30)

#prime :
Prime_Pure_t=axn(tb_act_t, x=60, m=30)/axn(tb_act_t, x=60, m=1,n=30)
Prime_Pure_t

#~~~~~~~~~~~~~~~~~~~~~~~~~~~ comapraison : male VS female VS

total~~~~~~~~~~~~~~~~~~~~~~~~~~~~:

#~~~~~~~~~~~~~~~~~~~~~~~~~~~ Espérence : male VS female VS

total~~~~~~~~~~~~~~~~~~~~~~~~~~~~:
ESP=matrix(c( "male :" ,"female : ", "total :" ,ESP_m,ESP_f,ESP_t),nrow = 3,ncol=2)
ESP

###################################################################
################################################
###- ===> on remarque que l'espérence de vie unisexe (totale) est presque la
moyenne entre l'espérence de vie      ###
###masculine et féminine .                                                                                                                   
###
###################################################################
################################################

#~~~~~~~~~~~~~~~~~~~~~~~~~~~ [Link] : male VS female VS

total~~~~~~~~~~~~~~~~~~~~~~~~~~~~:

P_Survie=matrix(c( "male :" ,"female : ",

"total :" ,P_Survie_m,P_Survie_f,P_Survie_t),nrow = 3,ncol=2)
P_Survie

###################################################################
################################################
###- ===> on remarque que la probabilité de survie unisexe (totale) est presque la
moyenne entre la probabilité ###
###de survie masculine et féminine .                                                                                               
###
###################################################################
################################################

#~~~~~~~~~~~~~~~~~~~~~~~~~~~ [Link] : male VS female VS

total~~~~~~~~~~~~~~~~~~~~~~~~~~~~:
P_deces=matrix(c( "male :" ,"female : ",
"total :" ,P_deces_m,P_deces_f,P_deces_t),nrow = 3,ncol=2)
P_deces

###################################################################
################################################
###- ===> on remarque que la probabilité de décès unisexe (totale) est presque la
moyenne entre la probabilité    ###
###de décès masculine et féminine .                                                                                               
###
###################################################################
################################################

#~~~~~~~~~~~~~~~~~~~~~~~~~~~ VAP: male VS female VS

total~~~~~~~~~~~~~~~~~~~~~~~~~~~~:
VAP=matrix(c( "male :" ,"female : ", "total :" ,VAP_m,VAP_f,VAP_t),nrow = 3,ncol=2)
VAP

###################################################################
################################################
###- ===> on remarque que la valeur actuelle probable unisexe (totale) est presque
la moyenne entre la valeur      ###
###actuelle probable masculine et féminine .                                                                               
###
###################################################################
################################################

# mais :

#### comparaison des primes pures :

Prime_Pure=matrix(c( "male :" ,"female : ",

"total :" ,Prime_Pure_m,Prime_Pure_f,Prime_Pure_t),nrow = 3,ncol=2)
Prime_Pure

###################################################################
################################################
### Pour une phase de test , on prend une population de 100 assurés : 40 hommes
et 60 femmes ,"proportions            ###
### prises en tenant compte que le portfeuille de l'assureur contient 60% femmes et
40% hommes"                                  ###
###      -La prime pure moyenne sera 40*0.24 + 60*0.38 /100 = 0.023                                 
###
###      -alors qu'en utilisant l'unisex la prime pure moyenne sera = 0.034 qui est mieu
pour l'assureur                      ###
###                                                                                                                                                                 
###
###      ===> Cet assureur peut différencier ses tarifs selon le genre de ses assurés   
###
###################################################################
################################################

#*********************************************Question"9":************************************
*********************

#***---NB:---***:

# Pour proposer une autre tarification on doit recalculer la valeur actuelle probable
en utilisant les taux projetés
# en plus des taux historiques.

#les taux de notre cohorte des individus nées en 1955 :

chosen_cohort=1955
lc_historical_rates <- extractCohort(fitted(LCfit1, type = "rates"), cohort =
chosen_cohort)

lc_forecasted_rates <- extractCohort(LCfor.t$rates,cohort = chosen_cohort)

lc_rates_1955 <- c(lc_historical_rates,lc_forecasted_rates)

lc_qx_1955 <-mx2qx(lc_rates_1955)

#transformation actuarialtable en lifetable:

lc_lifetable_1955 <- probs2lifetable(probs=lc_qx_1955,type = "qx", name =
paste("LC","1976","lt",sep="_"))

exn(lc_lifetable_1955,x=40)   

lc_acttbl_1955<-
new("actuarialtable",x=lc_lifetable_1955@x,lx=lc_lifetable_1955@lx,interest =0.03)

VAP_hist_projet = axn(lc_acttbl_1955, x=60, m=25) # on a projeté que 25 ans selon

le question "5"
VAP_hist_projet

Prime_Propose = axn(lc_acttbl_1955, x=60, m=25)/axn(lc_acttbl_1955, x=60,

m=1,n=25)
Prime_Propose

# Bonus : Provision mathématique

Provision = axn(lc_acttbl_1955,x=60,m=25) - axn(lc_acttbl_1955,x=60,n=25) *
Prime_Propose
Provision