Exercice 2.01

L’objectif de ce document est détudier la différence dans l’estimation de la tendance par régression linéaire entre une marche aléatoire et un signal linéraire bruité
Fiche 2
Marche aléatoire
Signal linéraire bruité
Author

Clément Poupelin

Published

March 3, 2025

Modified

March 3, 2025

Intervenant.e.s

Rédaction

Relecture

Setup

Show the code 
# Données
library(dplyr)        # manipulation des données

# Esthétique
library(latex2exp)   ## TeX
library(ggplot2)     ## ggplot
Show the code 
random_walk <- function(n, delta) {
  w <- rnorm(n)  
  drift <- delta * seq(1, n)  
  
  x <- drift + cumsum(w)
  return(x)  
}
Show the code 
noisy_serie <- function(n, delta) {
  w <- rnorm(n, sd = 1)  
  drift <- delta * seq(1, n) 
  
  x <- drift + w
  return(x)  
}
Show the code 
plot_simulation_time_series <- function(data, main_title, y_lab) {
  plot_data <- data.frame(
    Time = rep(1:n, I),
    Value = as.vector(data),
    Group = rep(1:I, each = n)
  )
  
  ggplot(plot_data, aes(
    x = Time,
    y = Value,
    group = Group,
    color = factor(Group)
  )) +
    geom_line() +
    scale_color_viridis_d(name = "Time séries")  +
    labs(title = main_title,
    x = "Time",
    y = y_lab) +
    theme_minimal() + 
    theme(legend.title = element_text(size = 18),
          legend.text = element_text(size = 12),
          axis.title = element_text(size = 16),
          axis.text = element_text(size = 14),
          plot.title = element_text(size = 18, face = "bold"))
  
}
Show the code 
plot_estimations <- function(coeff, theo_trend_x.pos, theo_trend_y.pos) {
  time <- seq(1, n)
  
  sim_data <- data.frame(
    time = rep(time, I),
    value = unlist(lapply(1:I, function(i)
      coeff[i] * time)),
    group = rep(1:I, each = n)
  )
  
  theoretical_trend <- data.frame(time = time,
                                  value = 0.01 * time,
                                  group = "Theoretical Trend")
  
  p <- ggplot(sim_data, aes(
    x = time,
    y = value,
    group = group,
    color = factor(group)
  )) +
    geom_line(size = .5, color = "orange") +
    geom_line(
      data = theoretical_trend,
      aes(x = time, y = value),
      color = "red",
      linetype = "dashed",
      size = 1.
    ) +
    labs(
      title = "Graphe of the estimations",
      x = "Time",
      y = "Estimated values",
      color = "Simulated Curves"
    ) +
    scale_color_manual(values = rep("orange", I)) +
    theme_minimal() +
    theme(legend.position = "topleft") +
    annotate(
      "text",
      x = theo_trend_x.pos,
      y = theo_trend_y.pos,
      label = TeX("Theoretical trend$\\delta t = 0.01t$"),
      color = "red",
      hjust = 0
    )
  return(p)
}
Show the code 
set.seed(140400)

Données

Pour cette exercice, nous allons étudier deux types de séries temporelles : les marches aléatoires et les signaux linéaires bruités.

Pour cela nous allons simuler :

  • dix marches aléatoires \((x^1_t)_t\)de la forme \(x^1_t = \delta + w_t\) avec dérive de longueur \(n=100\), de paramètre \(\delta=.01\) et de variance \(\sigma_W^2 = 1\) pour le bruit.

  • dix séries \((x^2_t)_t\) de la forme \(x^2_t = \delta t + w_t\) (tendance + bruit blanc) de longueur \(n = 100\), de paramètre \(\delta = .01\) et de variance \(\sigma^2_W = 1\)

Note

Si on pose que \(x_0 = w_0\), on peut écrire notre marche aléatoire comme \(x_t = \delta t + \sum_{i=0}^{t}w_i\)

Show the code 
n <- 100      ## length    
delta <- .01  ## drift parameter   
I <- 10       ## number of series
Show the code 
sim <- t(simplify2array(lapply(1:I, function(i) random_walk(n, delta))))
Show the code 
plot_simulation_time_series(sim, main_title = TeX(paste("Simulation of", I, "Random Walks with drift $\\delta$ =", delta)), y_lab = "Random Walk")

Show the code 
sim2 <- t(simplify2array(lapply(1:I, function(i) noisy_serie(n, delta))))
Show the code 
plot_simulation_time_series(sim2, main_title = paste("Simulation of", I, "linear noisy series"), y_lab = "Noisy serie")

Estimation du modèle de régression linéaire

Pour les deux types de séries, nous allons estimer le modèle de régression linéaire \[x^\xi_t = \beta t + w_t \quad \text{pour} \quad \xi=1,2\]

Show the code 
sim_coeff <- apply(sim, 1, function(x) {
  mod <- lm(x ~ 0 + seq(1, n)) 
  return(mod$coefficients)  
})

df_sim_coeff <- data.frame(coeff = paste("beta_", seq(1,10)), estimation = round(sim_coeff, 3))

t(df_sim_coeff) %>% DT::datatable()
Show the code 
sim_coeff %>% summary()
     Min.   1st Qu.    Median      Mean   3rd Qu.      Max. 
-0.214156 -0.033762  0.003651  0.002040  0.097599  0.183586

Résultats

Nous pouvons constater ici que les dix estimations varient entre \(-0.21\) et \(0.18\) avec une moyenne à \(0.002\) alors que notre tendance théorique est à \(.01\).

Show the code 
sim2_coeff <- apply(sim2, 1, function(x) {
  mod <- lm(x ~ 0 + seq(1, n))  
  return(mod$coefficients)  
})
df_sim2_coeff <- data.frame(coeff = paste("beta_", seq(1,10)), estimation = round(sim2_coeff, 3))

t(df_sim2_coeff) %>% DT::datatable()
Show the code 
sim2_coeff %>% summary()
    Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
0.008750 0.009751 0.010156 0.010456 0.010601 0.013139

Résultats

Nous pouvons constater ici que les dix estimations son proche de \(.01\) qui est notre tendance théorique.

Avec ces résulats, nous pouvons par la suite représenter sur un même graphique dix droites représentant l’évolution de nos séries à partir de nos dix estimations et une droite avec l’évolution de la série avec la tendance théorique \(\delta t=.01t\).

Show the code 
plot_estimations(sim_coeff, 5, 9)

Résultats

Nous pouvons facilement voir que les estimations ne semble pas du tout suivre la tendance moyenne théoriques.
La variance des estimations semble même croitre au cours du temps.

Show the code 
plot_estimations(sim2_coeff, 0.2, 0.5)

Résultats

Nous constatons ici que l’estimation semble très bien fonctionner avec des lignes qui semblent toutes proches de la tendance moyenne théorique.

Conclusion

Nous avons pu voir avec cette exercice que la tendance théorique (le drift) est mieux estimée par régression linéaire dans le cas d’un signal bruité que celui de la marche aléatoire.

Cela s’explique par le fait que, dans le cas de la marche aléatoire, la variance de \(x_t\) croît linéairement avec le temps. En effet, \[\begin{align*} Var(x_t) &= Var(\delta t + \sum_{i=0}^{t}w_i)\\ &= Var(\sum_{i=0}^{t}w_i)\\ &= \sum_{i=0}^{t}Var(w_i)\\ &= \sum_{i=0}^{t}\sigma^2_w\\ &= t\sigma^2_w \end{align*}\]

Cela fait donc défaut à l’hypothèse d’homoscédacité (la variance des erreurs est la même pour chaque observation) cruciale pour la régression linéaire.

Par contre, du côté du signal bruité on conserve l’homoscédacité avec le cas très idéal du bruit iid (indépendant et identiquement distribué) et gaussien.

Session info

Show the code 
sessioninfo::session_info(pkgs = "attached")
─ Session info ───────────────────────────────────────────────────────────────
 setting  value
 version  R version 4.4.2 (2024-10-31)
 os       Ubuntu 24.04.1 LTS
 system   x86_64, linux-gnu
 ui       X11
 language (EN)
 collate  fr_FR.UTF-8
 ctype    fr_FR.UTF-8
 tz       Europe/Paris
 date     2025-03-03
 pandoc   3.2 @ /usr/lib/rstudio/resources/app/bin/quarto/bin/tools/x86_64/ (via rmarkdown)

─ Packages ───────────────────────────────────────────────────────────────────
 package   * version date (UTC) lib source
 dplyr     * 1.1.4   2023-11-17 [1] CRAN (R 4.4.2)
 ggplot2   * 3.5.1   2024-04-23 [1] CRAN (R 4.4.2)
 latex2exp * 0.9.6   2022-11-28 [1] CRAN (R 4.4.2)

 [1] /home/clement/R/x86_64-pc-linux-gnu-library/4.4
 [2] /usr/local/lib/R/site-library
 [3] /usr/lib/R/site-library
 [4] /usr/lib/R/library

──────────────────────────────────────────────────────────────────────────────