È possibile creare un diagramma di "insiemi paralleli" usando R?


16

Grazie alla domanda di Tormod (pubblicata qui ) mi sono imbattuto nella trama di Parallel Sets . Ecco un esempio di come appare: inserisci qui la descrizione dell'immagine (È una visualizzazione del set di dati Titanic. Mostrando, ad esempio, come la maggior parte delle donne che non sono sopravvissute appartenevano alla terza classe ...)

Mi piacerebbe poter riprodurre una trama del genere con R. È possibile farlo?

Grazie Tal


1
Per idee sulla grafica, controllo sempre la galleria del grafico R. Ecco qualcosa da lì che è in qualche modo simile a quello che chiedi: R Graph Gallery parallel . L'ho trovato facendo clic in parallelo nel tag cloud, ma potrebbero esserci opzioni migliori.
Nick Sabbe,

1
Grazie Nick. Ma questo non funzionerà con dati categorici senza importanti modifiche al codice (probabilmente non è la migliore base di funzioni con cui costruirlo). Spero che qualcuno abbia già fatto qualcosa di simile ...
Tal Galili,

Risposte:


25

Ecco una versione che utilizza solo la grafica di base, grazie al commento di Hadley. (Per la versione precedente, consultare la cronologia delle modifiche).

terzo tentativo

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, risposta fantastica - Vorrei poterlo segnare V due volte. Grazie!
Tal Galili,

2
Contento che ti piaccia. È stato divertente. :) L'unica parte difficile è ottenere i punti in cui le barre dovrebbero iniziare e finire (che si trova nella getpsottofunzione); il resto sta solo disegnando poligoni.
Aaron - Ripristina Monica il

1
Solo un'altra panel.textlinea. Vedi modifica.
Aaron - Ripristina Monica il

1
Puoi fare trasparenza anche nella grafica di base.
Hadley,

2
Hai ragione. Me ne ero completamente dimenticato, essendo così abituato al modo reticolare di fare le cose. Per gli altri interessati, aggiungi un paio di caratteri in più sulla tua stringa di colore, ad esempio #FF000080. ?rgbha dettagli.
Aaron - Ripristina Monica il

Utilizzando il nostro sito, riconosci di aver letto e compreso le nostre Informativa sui cookie e Informativa sulla privacy.
Licensed under cc by-sa 3.0 with attribution required.