Analyse de ma collection de Picsou

Lorsque je ne fais pas des statistiques, je lis des bandes dessinées et en particulier des Picsou Magazine ! Cela fait plus de dix-huit que j’achète et que je collectionne ce merveilleux magazine.

Comme tout bon collectionneur, je tiens à jour un fichier contenant la liste de tous les numéros que je possède et de leur état. Je me demandais s’il était possible de tirer quelque chose de ces données. Eh bien c’est le cas !

Si l’on regarde la quantité et l’état de mes Picsou en fonction de leur date de publication on peut observer des points de rupture : sur certaines périodes, j’ai presque tous les numéros, alors que sur d’autres, j’en ai très peu. A l’aide d’un algorithme statistique, on identifie précisément tous ces points de rupture.

Ce qui est frappant, c’est que chacun de ces seuils correspond soit à un changement dans le magazine, soit à un évènement marquant dans ma vie. Regardez par vous-même :

Une visualisation de ma collection de Picsou Magazine. Cliquez dessus pour afficher en taille réelle.

 Faites le vous même avec R

Pour identifier les seuils, on commence par créer pour tous les Picsou une variable « Etat » qui vaut « manquant » si je n’ai pas le numéro et sinon « mauvais », « bon » etc. selon son état. Ensuite on utilise un arbre de régression pour essayer de prédire l’état d’un Picsou en fonction de sa date de publication.

Mon approche n’est pas très conventionnelle (en regardant le code, vous verrez que je bidouille pas mal), mais ça marche franchement bien !

library(data.table)

# Récupération des données
picsou <- read.csv2(url("http://francoisguillem.fr/data/picsou.csv"))
picsou <- data.table(picsou, key = "Numero")

# Cette ligne permet de faire apparaitre les Picsou manquants dans le tableau
data <- picsou[J(1:max(picsou$Numero))]

data$Mois <- (864 + data$Numero) %% 12 + 1
data$Annee <- 1900 + (864 + data$Numero) %/% 12

data[is.na(Etat), Etat := "Manquant"]

# Arbre de régression
reg <- tree(Etat ~ Numero, data = data)

plot(reg)
text(reg)

# récupération des seuils. tree n'a pas été conçu pour ça. Du coup on
# bidouille pas mal
seuils <- reg$frame$splits[,1]
seuils <- seuils[seuils != ""]
seuils <- gsub("<", "", seuils)
seuils <- as.numeric(seuils)
seuils <- sort(seuils)

# Découpage des données en périodes
data$Periode <- cut(data$Numero, breaks=c(0, seuils, Inf),
                    labels=1:(length(seuils) + 1))

# Résumé de chaque période. On regroupe les classes afin d'avoir une vision
# plus synthétique
data$Classe <- data$Etat

levels(data$Classe) <- c("mauvais", "mauvais", "excellent", "excellent",
                         "bon", "Manquant")

periodes <- data[, as.list(prop.table(table(Classe))), keyby = Periode]

# Graphique

seuilsAn <- c(1900 + (864 + c(1, seuils)) / 12, 2012)

gr <- rgb(124, 144, 156 ,max = 255)
cols <- c(gray(0.9), hsv(0.33, 0.5, 0.8), hsv(0.15, 0.8, 1), hsv(0.01, 0.7, 1))

pdf("output/picsou.pdf", 10, 10)
  par(col.axis = gr, col.lab = gr, fg = gr)
  oldpar <- par(xaxs='i',yaxs='i', las = 1, mar = c(35,4,3,10) + 0.1)
  plot(c(seuilsAn[1], 2012), c(0, 100), type = "n",
       xaxt = "n", yaxt = "n", xlab = "Date de parution", ylab = "")
  axis(1, at = c(seuilsAn[1], 1980, 1990, 2000, 2010),
       label = c(1972, 1980, 1990, 2000, 2010))
  axis(1, at = c(1975, 1985, 1995, 2005), lwd.ticks=0.5, label = rep("", 4))
  axis(2, at = 0:5 * 20, label = paste(0:5 * 20, "%"))

  rect(seuilsAn[1], 0, 2012, 100, border=gr, col = cols[1])
  for (i in 1:nrow(periodes)) {
    rect(seuilsAn[i], 0,
         seuilsAn[i+1], periodes[i, mauvais] * 100,
         border=NA, col = cols[4])
    rect(seuilsAn[i], periodes[i, mauvais] * 100,
         seuilsAn[i+1], periodes[i, mauvais + bon] * 100,
         border=NA, col = cols[3])
    rect(seuilsAn[i], periodes[i, mauvais + bon] * 100,
         seuilsAn[i+1], periodes[i, mauvais + bon + excellent] * 100,
         border=NA, col = cols[2])
  }

  segments(seuilsAn, 0, seuilsAn, 100, col = gray(0.3))

  text(seuilsAn + 0.7, 95, labels=1:length(seuilsAn))

  legend("right", xpd = TRUE, inset = c(-0.2, 0), bty = "n",
         legend = c("Manquant", "Excellent état", "bon état", "mauvais état"),
         fill = cols, border = NA)
  title("L'état de ma collection de Picsou Magazine", col.main = gr)
  par(oldpar)
dev.off()
Cette entrée a été publiée dans Non classé. Vous pouvez la mettre en favoris avec ce permalien.

Laisser un commentaire

Votre adresse de messagerie ne sera pas publiée. Les champs obligatoires sont indiqués avec *

*

Vous pouvez utiliser ces balises et attributs HTML : <a href="" title=""> <abbr title=""> <acronym title=""> <b> <blockquote cite=""> <cite> <code> <del datetime=""> <em> <i> <q cite=""> <strike> <strong>