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][(https://en.wikipedia.org/wiki/Poisson_regression)](https://fr.wikipedia.org/wiki/R%C3%A9gression_de_Poisson), 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 des entrées à la sortie. 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 car elle utilise une distribution de Poisson pour modéliser les étiquettes de sortie, au lieu d’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 moyen de Poisson.

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

Visualisation 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 utilisonscolor="red" et size=5 avec geom_point afin qu’il soit plus facile de voir les points sur un fond gris et de passer le curseur sur les points pour voir l’infobulle. Nous allons maintenant créer une version interactive avec animint2.

animint(prob.mass)

Vous pouvez cliquer sur la visualisation ci-dessus pour modifier la moyenne de la distribution de Poisson. Vous pouvez également survoler un point de données avec le curseur pour voir sa probabilité. Notez que pour les valeurs entières de la moyenne de Poisson, 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 à la fonction de répartition, nous allons modifier le ggplot en suivant l’esquisse ci-dessous.

Visualisation des probabilités cumulées dans la régression de Poisson

Lorsque nous spécifions les ensembles de données, nous utilisons l’idiome addColumn then facet 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 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. Ceci est un exemple de “montrer vos choix arbitraires”, l’un des principes généraux de la conception de bonnes visualisations de données interactives.

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 de l’étiquette 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 afin d’afficher des é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 des données avec un panneau supplémentaire.

(viz.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.

viz.log.loss <- viz.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
viz.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)"))
viz.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 pour le modèle de régression de Poisson.

Exercices :

  • Le code ci-dessus utilisait les fonctions d’aide addPanel et addX avec plusieurs geoms pour créer des graphiques multi-panneaux, 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 séquence similaire de visualisation des données pour le modèle de Régression binomiale.

Dans le chapitre 14, nous vous expliquerons comment utiliser les clickSelects/showSelected explicites pour visualiser le modèle d’apprentissage automatique PeakSegJoint avec des variables de sélection basées sur les données.