13  Régression de Poisson

L’objectif de ce chapitre est de créer une visualisation des données interactive qui explique la régression de Poisson (Wikipédia 2025), un modèle d’apprentissage automatique pour la prédiction d’une sortie à valeur entière à partir d’entrées sous forme de vecteurs à valeur réelle. Il s’agit d’un modèle de « régression linéaire » puisqu’il apprend une fonction linéaire dans l’espace des variables d’entrée. Comme la régression par les moindres carrés, la régression de Poisson peut être formulée comme un problème de maximum de vraisemblance. Cependant, elle en diffère par son utilisation d’une distribution de Poisson pour modéliser les étiquettes de sortie, plutôt qu’une distribution gaussienne. Ce choix de modélisation est approprié lorsque les étiquettes de sortie sont des nombres entiers non négatifs.

Plan du chapitre :

13.1 Tracer la fonction de masse de probabilité et sélectionner le paramètre de moyenne de Poisson

L’objectif de cette section est de créer une visualisation qui montre la fonction de masse de probabilité pour un paramètre de moyenne de Poisson sélectionné.

Esquisse d’un graphique des probabilités dans la régression de Poisson
library(data.table)
poisson.mean.diff <- 0.25
poisson.mean.vec <- seq(0, 5, by=poisson.mean.diff)
quantile.max <- 0.99
poisson.prob.list <- list()
for(poisson.mean in poisson.mean.vec){
  label.max <- qpois(quantile.max, poisson.mean)
  label <- 0:label.max
  probability <- dpois(label, poisson.mean)
  poisson.prob.list[[paste(poisson.mean)]] <- data.table(
    poisson.mean,
    label,
    probability,
    cum.prob=cumsum(probability))
}
poisson.prob <- do.call(rbind, poisson.prob.list)
poisson.prob
     poisson.mean label probability  cum.prob
  1:         0.00     0 1.000000000 1.0000000
  2:         0.25     0 0.778800783 0.7788008
 ---                                         
155:         5.00    10 0.018132789 0.9863047
156:         5.00    11 0.008242177 0.9945469

La visualisation des données statiques ci-dessous montre une facette pour chaque distribution de Poisson :

mean.tallrects <- data.table(
  poisson.mean=poisson.mean.vec,
  min=poisson.mean.vec - poisson.mean.diff/2,
  max=poisson.mean.vec + poisson.mean.diff/2)
library(animint2)
prob.mass <- ggplot()+
  theme_bw()+
  theme(panel.margin=grid::unit(0, "cm"))+
  geom_tallrect(aes(
    xmin=min, xmax=max),
    clickSelects="poisson.mean",
    alpha=0.6,
    data=mean.tallrects)+
  geom_point(aes(
    label, probability, 
    tooltip=sprintf("prob(label = %d) = %f", label, probability)),
    color="red",
    showSelected="poisson.mean",
    size=5,
    data=poisson.prob)
prob.mass+
  facet_wrap("poisson.mean")

Notez que nous avons utilisé alpha=0.6 avec geom_tallrect() ce qui signifie que le tallrect correspondant à la moyenne sélectionnée a une opacité de 0.6 et que les autres tallrects ont une opacité de 0.1. Notez également que nous utilisons color="red" et size=5 avec geom_point() afin de faciliter la visualisation des points sur un fond gris et le survol avec le curseur pour afficher l’infobulle. Nous allons maintenant créer une version interactive avec animint2.

animint(prob.mass)

Cliquez sur la visualisation ci-dessus pour modifier la moyenne de la distribution de Poisson. Vous pouvez également survoler un point avec le curseur pour afficher sa probabilité. Notez que pour les valeurs entières de la moyenne, il existe deux étiquettes qui sont les plus probables (le mode de la distribution de Poisson). Par exemple, la distribution de Poisson avec une moyenne de 3 atteint sa probabilité maximale d’environ 0.224 pour des valeurs d’étiquettes de 2 et 3.

13.2 Ajouter un panneau pour la fonction de répartition

Pour ajouter un panneau affichant la fonction de répartition, nous allons modifier le ggplot en suivant l’esquisse ci-dessous :

Esquisse d’un graphique des probabilités cumulées dans la régression de Poisson

Lorsque nous spécifions les ensembles de données, nous utilisons la méthode rajouter colonnes et facettes, pour ajouter une variable panel.

addPanel <- function(dt, panel){
  data.table(dt, panel=factor(panel, c("probability", "cum prob")))
}
quantile.max.dt <- data.table(quantile.max)
animint(
  prob=ggplot()+
    theme_bw()+
    theme(panel.margin=grid::unit(0, "cm"))+
    facet_grid(panel ~ ., scales="free")+
    geom_hline(aes(
      yintercept=quantile.max),
      color="grey",
      data=addPanel(quantile.max.dt, "cum prob"))+
    geom_tallrect(aes(
      xmin=min, xmax=max),
      clickSelects="poisson.mean",
      alpha=0.6,
      data=mean.tallrects)+
    geom_point(aes(
      label, probability,
      tooltip=sprintf(
        "prob(label = %d) = %f", label, probability)),
      showSelected="poisson.mean",
      color="red",
      size=5,
      data=addPanel(poisson.prob, "probability"))+
    geom_point(aes(
      label, cum.prob, 
      tooltip=sprintf(
        "prob(label <= %d) = %f", label, cum.prob)),
      showSelected="poisson.mean",
      color="red",
      size=5,
      data=addPanel(poisson.prob, "cum prob")))

Notez que nous avons utilisé addPanel pour ajouter une variable panel à tous les ensembles de données pour chaque geom, à l’exception de geom_tallrect(). Utiliser panel comme variable à facettes a pour effet de dessiner chaque geom dans un seul panneau, à l’exception de geom_tallrect() qui lui est dessiné dans chaque panneau.

Notez l’utilisation d’un geom_hline() pour indiquer le seuil de la fonction de répartition, 0.99, servant à déterminer l’ensemble des points à tracer pour chaque distribution de Poisson.

13.3 Ajout d’un graphique de la perte de Poisson et d’un sélecteur pour la valeur de l’étiquette

Nous allons ensuite calculer la perte de Poisson pour plusieurs valeurs d’étiquettes de sortie.

PoissonLoss <- function(label, seg.mean){
  stopifnot(is.numeric(label))
  stopifnot(is.numeric(seg.mean))
  if(any(seg.mean < 0)){
    stop("PoissonLoss undefined for negative segment mean")
  }
  if(length(seg.mean)==1)seg.mean <- rep(seg.mean, length(label))
  if(length(label)==1)label <- rep(label, length(seg.mean))
  stopifnot(length(seg.mean) == length(label))
  not.integer <- round(label) != label
  is.negative <- label < 0
  loss <- ifelse(
    not.integer | is.negative, Inf,
    ifelse(seg.mean == 0, ifelse(label == 0, 0, Inf),
           seg.mean - label * log(seg.mean)
           ## This term makes all the minima zero.
           -ifelse(label == 0, 0, label - label*log(label))))
  loss
}

Ci-dessous, nous calculons la perte pour plusieurs valeurs d’étiquettes, en utilisant la méthode Liste de tableau de données.

label.vec <- unique(poisson.prob$label)
label.range <- range(label.vec)
mean.vec <- seq(label.range[1], label.range[2], l=100)
loss.min.list <- list()
loss.fun.list <- list()
for(label in label.vec){
  loss <- PoissonLoss(label, mean.vec)
  loss.fun.list[[paste(label)]] <- data.table(
    label, poisson.mean=mean.vec, loss)
  loss.min.list[[paste(label)]] <- data.table(
    label, loss=0)
}
loss.fun <- do.call(rbind, loss.fun.list)
loss.min <- do.call(rbind, loss.min.list)

Nous créons également un tableau de données pour afficher les étiquettes de texte pour les valeurs de moyenne et d’étiquette sélectionnées.

mean.text <- data.table(
  label=max(poisson.prob$label)/2,
  probability=0.95,
  poisson.mean=poisson.mean.vec)
loss.max <- 10
label.text <- data.table(
  poisson.mean=max(mean.tallrects$max),
  loss=loss.max*0.95,
  label=label.vec)

Ensuite, nous créons une visualisation avec un panneau supplémentaire.

(vis.loss <- animint(
  prob=ggplot()+
    theme_bw()+
    theme(panel.margin=grid::unit(0, "cm"))+
    facet_grid(panel ~ ., scales="free")+
    geom_text(aes(
      label, probability, label=sprintf(
      "Poisson mean = %.2f", poisson.mean)),
      color="red",
      showSelected="poisson.mean", 
      data=addPanel(mean.text, "probability"))+
    geom_hline(aes(
      yintercept=quantile.max),
      color="grey",
      data=addPanel(quantile.max.dt, "cum prob"))+
    geom_point(aes(
      label, probability,
      tooltip=sprintf(
        "prob(label = %d) = %f", label, probability)),
      showSelected="poisson.mean",
      clickSelects="label",
      color="red",
      size=5,
      alpha=0.7,
      data=addPanel(poisson.prob, "probability"))+
    geom_point(aes(
      label, cum.prob,
      tooltip=sprintf(
        "prob(label <= %d) = %f", label, cum.prob)),
      color="red",
      showSelected="poisson.mean",
      clickSelects="label",
      size=5,
      alpha=0.7,
      data=addPanel(poisson.prob, "cum prob")),
  loss=ggplot()+
    theme_bw()+
    geom_text(aes(
      poisson.mean, loss,
      label=sprintf("label = %d", label)),
      showSelected="label",
      hjust=0,
      data=label.text)+
    geom_line(aes(
      poisson.mean, loss),
      showSelected="label",
      data=loss.fun)+
    geom_point(aes(
      label, loss),
      showSelected="label",
      data=loss.min)+
    geom_tallrect(aes(
      xmin=min, xmax=max),
      clickSelects="poisson.mean",
      alpha=0.6,
      data=mean.tallrects)))

La visualisation des données ci-dessus montre la probabilité à gauche et la perte de Poisson à droite.

vis.log.loss <- vis.loss
addX <- function(dt, x.var)data.table(dt, x.var=factor(
  x.var, c("poisson mean", "log(poisson mean)")))
finite.loss <- loss.fun[is.finite(loss)]
finite.loss[, log.poisson.mean := log(poisson.mean)]
finite.log.loss <- finite.loss[is.finite(log.poisson.mean)]
mean.tallrects[, log.min := ifelse(min < 0, -Inf, log(min))]
Warning in log(min): NaNs produced
vis.log.loss$loss <- ggplot()+
  theme_bw()+
  theme(panel.margin=grid::unit(0, "lines"))+
  facet_grid(. ~ x.var, scales="free")+
  xlab("")+
  coord_cartesian(ylim=c(0, loss.max))+
  geom_text(aes(
    poisson.mean, loss, label=sprintf(
                          "label = %d", label)),
    showSelected="label",
    hjust=0,
    data=addX(label.text, "poisson mean"))+
  geom_line(aes(
    poisson.mean, loss),
    showSelected="label",
    data=addX(finite.loss, "poisson mean"))+
  geom_point(aes(
    label, loss),
    showSelected="label",
    data=addX(loss.min, "poisson mean"))+
  geom_tallrect(aes(
    xmin=min, xmax=max),
    clickSelects="poisson.mean",
    alpha=0.6,
    data=addX(mean.tallrects, "poisson mean"))+
  geom_line(aes(
    log.poisson.mean, loss),
    showSelected="label",
    data=addX(finite.log.loss, "log(poisson mean)"))+
  geom_point(aes(
    log(label), loss),
    showSelected="label",
    data=addX(loss.min[0<label,], "log(poisson mean)"))+
  geom_tallrect(aes(
    xmin=log.min, xmax=log(max)),
    clickSelects="poisson.mean",
    alpha=0.6,
    data=addX(mean.tallrects, "log(poisson mean)"))
vis.log.loss

13.4 Résumé du chapitre et exercices

Nous avons expliqué comment visualiser la distribution et la perte de Poisson, qui sont utilisées dans le modèle de régression de Poisson.

Exercices :

  • Le code présenté dans la section précédente utilise les fonctions d’aide addPanel et addX avec plusieurs geoms pour créer des graphiques multipanneaux, ce qui entraîne des répétitions. Pour les éviter, créez une nouvelle visualisation des données qui utilise un seul geom avec un ensemble de données plus important. Par exemple, les points rouges dans les deux panneaux du premier graphique pourraient être définis à l’aide d’un seul geom_point() avec un ensemble de données plus important. Conseil : utilisez data.table::melt() avec measure.vars=c("cum.prob", "probability").
  • Créez une visualisation des données pour la régression binomiale (Wikipédia 2026).

Dans le chapitre 14, nous vous expliquerons comment utiliser des clickSelects et showSelected nommés pour créer une visualisation avec plusieurs variables de sélection.