Dépendances de queue des délais et des montants

Le coefficient de corrélation, étant l’indicateur le plus couramment utilisé pour mesurer la dépendance entre les variables, montre que la corrélation entre les délais de paiement et les montants des paiements est de . Cela suggère que ces deux variables ne sont pas corrélées de manière significative en général. Les copules permettent de modéliser et de déterminer les dépendances des queues . On a la définition suivante :

Librairies utiles sont :

library(readr)
library(dplyr)
library(data.table)
library(copula)

Importation des données

delais_montant <- read_csv("C:/Users/JKLEVINE/Desktop/Memoire/MODELEDURE.csv") %>%
  dplyr::select(RembOam, DelaiPaiement)

names(delais_montant) <- c("RO", "DP")

Resumé statistiques

summary(delais_montant)
##        RO                 DP         
##  Min.   :    0.01   Min.   :   1.00  
##  1st Qu.:    9.68   1st Qu.:   5.00  
##  Median :   20.00   Median :   9.00  
##  Mean   :   54.05   Mean   :  23.22  
##  3rd Qu.:   42.64   3rd Qu.:  21.00  
##  Max.   :60468.80   Max.   :1019.00

Dans un premier temps, nous allons ajuster des copules de valeurs extrêmes aux deux variables : le délai de paiement et le montant de remboursement.

set.seed(123)
DP.MP <- delais_montant

Convertir les données en variables uniformes sur l’intervalle \([0, 1]\).

X <- DP.MP$DP
Y <- DP.MP$RO


U <- pobs(X)
V <- pobs(Y)

data <- as.matrix(cbind(U,V))

Copules des valeurs extremes

Définition : Une copule de valeurs extrêmes (ou extreme value copula, copule EV) vérifie la relation suivante : \[ C\left(u_1^t, \ldots, u_n^t\right) = C^t\left(u_1, \ldots, u_n\right), \quad \forall t > 0. \]

Copule de Gumbel

La copule de Gumbel est définie par la fonction bivariée : \[ C_\alpha(u, v) = \exp \left\{ - \left[ (-\ln u)^\alpha + (-\ln v)^\alpha \right]^{\frac{1}{\alpha}} \right\}, \] où \(\alpha \geq 1\) est le paramètre de la copule.

gumbel_copula <- gumbelCopula(dim = 2)
fit_gumbel <- fitCopula(gumbel_copula, data = data, method = "ml")
summary(fit_gumbel)
## Call: fitCopula(gumbel_copula, data = data, ... = pairlist(method = "ml"))
## Fit based on "maximum likelihood" and 31802 2-dimensional observations.
## Gumbel copula, dim. d = 2 
##       Estimate Std. Error
## alpha    1.021      0.003
## The maximized loglikelihood is 22.6 
## Optimization converged
## Number of loglikelihood evaluations:
## function gradient 
##       18       18

Extraire les paramètres de la copule de Gumbel

gumbel_param <- fit_gumbel@estimate
cat("Paramètre de la copule de Gumbel:", gumbel_param, "\n")
## Paramètre de la copule de Gumbel: 1.020602

Copule de Student

On peut définir indirectement la copule de Student (ou t-Copula) par l’intermédiaire du théorème de Sklar. Un vecteur aléatoire suivant la loi de Student se définit par des lois marginales de loi de Student liées à une copule de Student. Ainsi, on peut définir la copule de Student de la façon suivante :

Soient \(T_{\Sigma,\nu}\) et \(T_{\nu}\) respectivement les fonctions de répartition des lois \(T(\Sigma, \nu)\) et \(T(\nu)\). La copule de Student se définit alors par : \[ C(u_1, \ldots, u_n) = T_{\Sigma,\nu}(T_{\nu}^{-1}(u_1), \ldots, T_{\nu}^{-1}(u_n)) \]

Dans le cas bivarié, la copule de Student, de coefficient de corrélation \(\rho\) et de degré de liberté \(\nu\) est donnée par : \[ C_{\rho,\nu}(u, v) = \int_{-\infty}^{t_{\nu}^{-1}(u)} \int_{-\infty}^{t_{\nu}^{-1}(v)} \frac{\Gamma\left(\frac{\nu + 2}{2}\right)}{2\pi \Gamma\left(\frac{\nu}{2}\right) \sqrt{1 - \rho^2}} \left[1 + \frac{s^2 + t^2 - 2\rho st}{\nu(1 - \rho^2)}\right]^{-\frac{\nu+2}{2}} ds\,dt \] où \(\Gamma\) est la fonction Gamma et \(t_{\nu}\) est la fonction de répartition de la loi de Student à \(\nu\) degrés de liberté : \[ t_{\nu}(x) = \int_{-\infty}^{x} \frac{\Gamma\left(\frac{\nu + 2}{2}\right)}{\sqrt{\nu\pi} \Gamma\left(\frac{\nu}{2}\right)} \left[1 + \frac{t^2}{\nu}\right]^{-\frac{\nu+1}{2}} dt \]

La copule de Student capte correctement les dépendances de queues à gauche et à droite. Si le degré de liberté \(\nu \to \infty\), alors la copule de Student converge vers la copule gaussienne.

# Définir et ajuster la copule t de Student
t_copula <- tCopula(dim = 2)
fit_t <- fitCopula(t_copula, data = cbind(U, V), method = "ml")
summary(fit_t)
## Call: fitCopula(t_copula, data = cbind(U, V), ... = pairlist(method = "ml"))
## Fit based on "maximum likelihood" and 31802 2-dimensional observations.
## t-copula, dim. d = 2 
##       Estimate Std. Error
## rho.1  0.03173      0.006
## df    19.41239      2.737
## The maximized loglikelihood is 49.65 
## Optimization converged
## Number of loglikelihood evaluations:
## function gradient 
##       17       17
# Extraire les paramètres de la copule t de Student
t_params <- fit_t@estimate
cat("Paramètres de la copule t de Student:", t_params, "\n")
## Paramètres de la copule t de Student: 0.03173179 19.41239

Copule de Clayton

Le générateur de la copule de Clayton s’écrit : \[ \varphi(t) = \frac{t^{-\alpha} - 1}{\alpha}, \quad \alpha \in ]0, +\infty[ \]

On peut donc écrire la copule de Clayton sous la forme multivariée de la façon suivante : \[ C_{\alpha}(u_1, \ldots, u_n) = \left(u_1^{-\alpha} + \ldots + u_n^{-\alpha} - n + 1\right)^{-\frac{1}{\alpha}} \]

Il existe une dépendance de queue à gauche pour la copule de Clayton. Cependant, la copule n’admet pas de dépendance de queue à droite. Nous verrons ce cas de dépendance plus en détail dans le prochain chapitre.

clayton_copula <- claytonCopula(dim = 2)
fit_clayton <- fitCopula(clayton_copula, data = cbind(U, V), method = "mpl")
summary(fit_clayton)
## Call: fitCopula(clayton_copula, data = cbind(U, V), ... = pairlist(method = "mpl"))
## Fit based on "maximum pseudo-likelihood" and 31802 2-dimensional observations.
## Clayton copula, dim. d = 2 
##       Estimate Std. Error
## alpha  0.01932      0.006
## The maximized loglikelihood is 4.793 
## Optimization converged
## Number of loglikelihood evaluations:
## function gradient 
##        6        6
# Extraire les paramètres de la copule de Clayton
clayton_param <- fit_clayton@estimate
cat("Paramètre de la copule de Clayton:", clayton_param, "\n")
## Paramètre de la copule de Clayton: 0.01932094
# Définir la fonction de dépendance A_n pour la copule de Clayton
An_clayton <- function(v, theta) {
  return((v^(-theta) + (1 - v)^(-theta) - 1)^(-1 / theta))
}

# Évaluer la fonction de dépendance à des points spécifiques
v_values <- seq(0, 1, by = 0.01)
An_values <- An_clayton(v_values, clayton_param)

# Tracer la fonction de dépendance
plot(v_values, An_values, type = "l", col = "blue",
     xlab = expression(v), ylab = expression(A[n](v)),
     main = "Fonction de dépendance pour la copule de Clayton")

copule de Galambos

La copule de Galambos est aussi de type extrême. Elle s’écrit : \[ C_{\theta}(u, v) = uv \exp\left[ -\left(\left(\log \frac{1}{u}\right)^{-\theta} + \left(\log \frac{1}{v}\right)^{-\theta}\right)^{-1/\theta} \right], \] où \(\theta > 0\) et \((u, v) \in [0, 1]^2\). On obtient l’indépendance quand \(\theta \to 0\). L’algorithme présenté par Ghoudi, Khoudraji & Rivest (1998) a été utilisé pour la simulation de couples de cette loi.

Les graphiques mettent en évidence la bonne performance du test basé sur \(\xi_n\). Comme dans le cas de la copule de Gumbel, le test basé sur \(\xi_n\) s’avère moins puissant.

galambos_copula <- galambosCopula()
fit_galambos <- fitCopula(galambos_copula, data = cbind(U, V), method = "ml")
summary(fit_galambos)
## Call: fitCopula(galambos_copula, data = cbind(U, V), ... = pairlist(method = "ml"))
## Fit based on "maximum likelihood" and 31802 2-dimensional observations.
## Galambos copula, dim. d = 2 
##       Estimate Std. Error
## alpha   0.2145      0.006
## The maximized loglikelihood is 60.77 
## Optimization converged
## Number of loglikelihood evaluations:
## function gradient 
##       28        6
# Extraire les paramètres de la copule de Galambos
galambos_param <- fit_galambos@estimate
cat("Paramètre de la copule de Galambos:", galambos_param, "\n")
## Paramètre de la copule de Galambos: 0.2144871
# Définir la fonction de dépendance A_n pour la copule de Galambos
An_galambos <- function(v, theta) {
  return((v^(-theta) + (1 - v)^(-theta))^(-1 / theta))
}

# Évaluer la fonction de dépendance à des points spécifiques
v_values <- seq(0, 1, by = 0.01)
An_values <- An_galambos(v_values, galambos_param)

# Tracer la fonction de dépendance
plot(v_values, An_values, type = "l", col = "blue",
     xlab = expression(v), ylab = expression(A[n](v)),
     main = "Fonction de dépendance pour la copule de Galambos")

Fonction de dependance

La fonction de dépendance d’une copule de valeurs extrêmes, souvent appelée ou , est une fonction clé qui caractérise les copules de valeurs extrêmes. Cette fonction est utilisée pour décrire la dépendance entre les variables dans des situations où des événements extrêmes (tels que des valeurs très élevées ou très basses) se produisent simultanément.

Définition Formelle

Soit \(C\) une copule de valeurs extrêmes pour un vecteur aléatoire \((U_1, \ldots, U_d)\), où chaque \(U_i\) est une variable uniforme sur \([0, 1]\). La copule \(C\) est associée à une fonction de dépendance exponentielle \(A\), définie sur le \(d\)-simplexe \(S_{d-1} = \{ \mathbf{w} \in \mathbb{R}^d : w_i \geq 0, \sum_{i=1}^d w_i = 1 \}\), par l’équation suivante :

\[ C(u_1, \ldots, u_d) = \exp\left[-A\left(-\log u_1, \ldots, -\log u_d\right)\right] \]

où la fonction \(A\) satisfait les propriétés suivantes :

  1. Marginalisation : \(A(1, 0, \ldots, 0) = A(0, 1, \ldots, 0) = \ldots = A(0, \ldots, 0, 1) = 1\).

  2. Convexité : \(A\) est une fonction convexe.

  3. Bornes : Pour tout \(\mathbf{w} \in S_{d-1}\), \(\max(w_1, \ldots, w_d) \leq A(\mathbf{w}) \leq 1\).

Interprétation

  • Complète dépendance : Si \(A(\mathbf{w}) = 1\), cela correspond à une situation où les variables sont complètement dépendantes, c’est-à-dire qu’elles tendent à atteindre des valeurs extrêmes ensemble.

  • Indépendance : Si \(A(\mathbf{w}) = \max(w_1, \ldots, w_d)\), cela correspond à une situation d’indépendance, où les variables ne partagent aucune dépendance particulière lors d’événements extrêmes.

La fonction de dépendance exponentielle \(A\) joue un rôle crucial dans la caractérisation des copules de valeurs extrêmes. Elle capture la manière dont des événements extrêmes sont susceptibles de se produire simultanément, offrant ainsi une compréhension fine de la dépendance extrême entre les variables.

simulated_data_gumbel <- rCopula(10000, gumbelCopula(gumbel_param, dim = 2))

simulated_data_student <- rCopula(10000, tCopula(param = fit_t@estimate[1], df = fit_t@estimate[2], dim = 2))

simulated_data_clayton <- rCopula(10000, claytonCopula(param = clayton_param, dim = 2))

simulated_data_galambos <- rCopula(10000, galambosCopula(param = galambos_param))


# Tracer les courbes des fonctions de dépendance sur le même graphique
plot(NA, xlim = c(0, 1), ylim = c(0.9, 1), xlab = "w", ylab = "A(w)", type = "n")

curve(An.biv(simulated_data_gumbel, x), from = 0, to = 1, col = "blue", lty = 1, add = TRUE)
curve(An.biv(simulated_data_student, x), from = 0, to = 1, col = "red", lty = 2, add = TRUE)
curve(An.biv(simulated_data_clayton, x), from = 0, to = 1, col = "green", lty = 3, add = TRUE)
curve(An.biv(simulated_data_galambos, x), from = 0, to = 1, col = "purple", lty = 4, add = TRUE)

# Ajouter une légende
legend("bottomright", legend = c("Gumbel", "Student", "Clayton", "Galambos"),
       col = c("blue", "red", "green", "purple"), lty = 1:4)

Les fonctions de dépendance pour les différentes copules montrent des valeurs proches de 1, ce qui indique une forte dépendance entre les variables. Cela suggère que les délais de paiement et les montants de remboursement ne sont pas indépendants. En d’autres termes, les analyses des fonctions de dépendance révèlent que ces deux variables ont tendance à atteindre des valeurs extrêmes simultanément. Cette observation souligne une forte corrélation entre les deux variables en ce qui concerne les événements extrêmes.

Dépendance des Queues Supérieures

La dépendance des queues supérieures est définie par :

\[ \lambda_U = \lim_{u \to 1^-} \Pr(U > u \mid V > u) \]

où \(\lambda_U\) est le coefficient de dépendance de queue supérieure.

Interprétation

  • Dépendance Totale (\(\lambda_U = 1\)) : Les variables sont parfaitement dépendantes dans les queues supérieures. Autrement dit, si une variable atteint des valeurs extrêmes, l’autre variable le fera presque certainement aussi.

  • Aucune Dépendance (\(\lambda_U = 0\)) : Les variables sont indépendantes dans les queues supérieures. Une valeur extrême dans une variable n’affecte pas la probabilité d’une valeur extrême dans l’autre.

  • Dépendance Partielle (\(0 < \lambda_U < 1\)) : Il existe une dépendance partielle. Les valeurs extrêmes dans une variable augmentent la probabilité de valeurs extrêmes dans l’autre, sans garantir une dépendance parfaite.

# Function to calculate upper tail dependence
upper_tail_dependence <- function(data, threshold = 0.975) {
  # Define the threshold for extreme values
  u_threshold <- quantile(data[,1], threshold)
  v_threshold <- quantile(data[,2], threshold)
  
  # Calculate the conditional probability
  prob_U_given_V <- mean(data[,1] > u_threshold & data[,2] > v_threshold) / mean(data[,1] > v_threshold)
  
  return(prob_U_given_V)
}


# Estimate upper tail dependence for each copula
upper_tail_gumbel <- upper_tail_dependence(simulated_data_gumbel)
upper_tail_student <- upper_tail_dependence(simulated_data_student)
upper_tail_clayton <- upper_tail_dependence(simulated_data_clayton)
upper_tail_galambos <- upper_tail_dependence(simulated_data_galambos)

results <- data.frame(
  Copula = c("Gumbel", "Student", "Clayton", "Galambos"),
  UpperTailDependence = c(upper_tail_gumbel, upper_tail_student, upper_tail_clayton, upper_tail_galambos)
)

print(results)
##     Copula UpperTailDependence
## 1   Gumbel          0.03666667
## 2  Student          0.05098039
## 3  Clayton          0.01176471
## 4 Galambos          0.08032129

Pour avoir la valeurs de \(\lambda\), il faut que que ecart soit de plus en plus petit.

upper_tail <- function(copule, ecart){
  
  u_point <- 1 - ecart
  copula_value <- pCopula(cbind(u_point, u_point), copule)
  lambda <- (1-2*u_point+copula_value)/(1-u_point)

  return(lambda)
}
copule_gumbel <- gumbelCopula(gumbel_param, dim = 2)
copule_student <- tCopula(param = fit_t@estimate[1], df = round(fit_t@estimate[2]), dim = 2)
copule_clayton <- claytonCopula(param = clayton_param, dim = 2)
copule_galambos <- galambosCopula(param = galambos_param)
upper_tail_gumbel <- upper_tail(copule_gumbel, ecart = 0.00000001)
upper_tail_student <- upper_tail(copule_student, ecart = 0.000001)
upper_tail_clayton <- upper_tail(copule_clayton, ecart = 0.000001)
upper_tail_galambos <- upper_tail(copule_galambos, ecart = 0.000001)


results <- data.frame(
  Copula = c("Gumbel", "Student", "Clayton", "Galambos"),
  UpperTailDependence = c(upper_tail_gumbel, upper_tail_student, upper_tail_clayton, upper_tail_galambos)
)

print(results)
##     Copula UpperTailDependence
## 1   Gumbel        2.778934e-02
## 2  Student        1.412716e-03
## 3  Clayton        1.027844e-06
## 4 Galambos        3.949324e-02

On faisant tendre le \(\alpha\) vers 1, on obtient des valeurs finie de \(\lambda\). Ce qui permet de conlure sur l’existence d’un upper tail dependence. Le copule de Clayton ne possede pas de upper tail dependence.

Tau de Kendall et Rho de Spearman

Le Tau de Kendall et le Rho de Spearman jouent, d’une certaine manière, un rôle similaire pour les copules à celui de la corrélation pour la distribution gaussienne. Ils sont parfois appelés des mesures de corrélation “non-linéaire” (par opposition au caractère linéaire de la corrélation de Pearson). Ils sont définis par :

\[ \tau = 4 \int_0^1 \int_0^1 C(u_1, u_2) \, dC(u_1, u_2) - 1 \quad \text{et} \quad \rho = 12 \int_0^1 \int_0^1 u_1 u_2 \, dC(u_1, u_2) - 3 \]

tau(copule_gumbel)
## [1] 0.02018633
tau(copule_student)
## [1] 0.02020447
tau(copule_clayton)
## [1] 0.009568037
tau(copule_galambos)
## [1] 0.03001715

Pour les 4 copules les taux de Kendall sont assez proches de 0.

rho(copule_gumbel)
## [1] 0.02822878
rho(copule_clayton)
## [1] 0.01459457
rho(copule_galambos)
## [1] 0.04496785

Pareil pour les valeurs des \(\rho\) qui sont assez proches de 0.