Est-il possible de créer un tracé "ensembles parallèles" en utilisant R?


16

Grâce à la question de Tormod (publiée ici ), je suis tombé sur l' intrigue des ensembles parallèles . Voici un exemple de son apparence: entrez la description de l'image ici (Il s'agit d'une visualisation de l'ensemble de données Titanic. Montrant, par exemple, comment la plupart des femmes qui n'ont pas survécu appartenaient à la troisième classe ...)

J'aimerais pouvoir reproduire un tel complot avec R. Est-ce possible de le faire?

Merci, Tal


1
Pour des idées sur les graphiques, je vérifie toujours la galerie de graphes R. Voici quelque chose qui ressemble un peu à ce que vous demandez: R Graph Gallery parallel . Je l'ai trouvé en cliquant sur parallèle dans le nuage de tags, mais il peut y avoir de meilleures options.
Nick Sabbe

1
Merci Nick. Mais cela ne fonctionnera pas pour les données catégorielles sans peaufinage majeur du code (ce n'est probablement pas non plus la meilleure base de fonctions pour construire cela). J'espère que quelqu'un aurait déjà fait quelque chose de similaire ...
Tal Galili

Réponses:


25

Voici une version utilisant uniquement des graphiques de base, grâce au commentaire de Hadley. (Pour la version précédente, voir l'historique des modifications).

troisième essai

parallelset <- function(..., freq, col="gray", border=0, layer, 
                             alpha=0.5, gap.width=0.05) {
  p <- data.frame(..., freq, col, border, alpha, stringsAsFactors=FALSE)
  n <- nrow(p)
  if(missing(layer)) { layer <- 1:n }
  p$layer <- layer
  np <- ncol(p) - 5
  d <- p[ , 1:np, drop=FALSE]
  p <- p[ , -c(1:np), drop=FALSE]
  p$freq <- with(p, freq/sum(freq))
  col <- col2rgb(p$col, alpha=TRUE)
  if(!identical(alpha, FALSE)) { col["alpha", ] <- p$alpha*256 }
  p$col <- apply(col, 2, function(x) do.call(rgb, c(as.list(x), maxColorValue = 256)))
  getp <- function(i, d, f, w=gap.width) {
    a <- c(i, (1:ncol(d))[-i])
    o <- do.call(order, d[a])
    x <- c(0, cumsum(f[o])) * (1-w)
    x <- cbind(x[-length(x)], x[-1])
    gap <- cumsum( c(0L, diff(as.numeric(d[o,i])) != 0) )
    gap <- gap / max(gap) * w
    (x + gap)[order(o),]
  }
  dd <- lapply(seq_along(d), getp, d=d, f=p$freq)
  par(mar = c(0, 0, 2, 0) + 0.1, xpd=TRUE )
  plot(NULL, type="n",xlim=c(0, 1), ylim=c(np, 1),
       xaxt="n", yaxt="n", xaxs="i", yaxs="i", xlab='', ylab='', frame=FALSE)
  for(i in rev(order(p$layer)) ) {
     for(j in 1:(np-1) )
     polygon(c(dd[[j]][i,], rev(dd[[j+1]][i,])), c(j, j, j+1, j+1),
             col=p$col[i], border=p$border[i])
   }
   text(0, seq_along(dd), labels=names(d), adj=c(0,-2), font=2)
   for(j in seq_along(dd)) {
     ax <- lapply(split(dd[[j]], d[,j]), range)
     for(k in seq_along(ax)) {
       lines(ax[[k]], c(j, j))
       text(ax[[k]][1], j, labels=names(ax)[k], adj=c(0, -0.25))
     }
   }           
}

data(Titanic)
myt <- subset(as.data.frame(Titanic), Age=="Adult", 
              select=c("Survived","Sex","Class","Freq"))
myt <- within(myt, {
  Survived <- factor(Survived, levels=c("Yes","No"))
  levels(Class) <- c(paste(c("First", "Second", "Third"), "Class"), "Crew")
  color <- ifelse(Survived=="Yes","#008888","#330066")
})

with(myt, parallelset(Survived, Sex, Class, freq=Freq, col=color, alpha=0.2))

Aaron, wow, réponse fantastique - j'aimerais pouvoir la marquer V deux fois. Je vous remercie!
Tal Galili

2
Content que tu aimes ça. C'était amusant. :) La seule partie délicate est d'obtenir les endroits où les barres doivent commencer et se terminer (ce qui est dans la getpsous - fonction); le reste ne fait que dessiner des polygones.
Aaron - Rétablir Monica

1
Juste une autre panel.textligne. Voir modifier.
Aaron - Rétablir Monica le

1
Vous pouvez également faire de la transparence dans les graphiques de base.
hadley

2
Tu as raison. J'avais complètement oublié cela, étant tellement habitué à la façon dont les choses se font en treillis. Pour les autres personnes intéressées, vous ajoutez quelques caractères supplémentaires à votre chaîne de couleur, par exemple #FF000080,. ?rgba des détails.
Aaron - Rétablir Monica le

En utilisant notre site, vous reconnaissez avoir lu et compris notre politique liée aux cookies et notre politique de confidentialité.
Licensed under cc by-sa 3.0 with attribution required.