¿Es posible crear una trama de "conjuntos paralelos" usando R?

16

Gracias a la pregunta de Tormod (publicada aquí ) me encontré con la trama de Conjuntos paralelos . Aquí hay un ejemplo de cómo se ve: ingrese la descripción de la imagen aquí (Es una visualización del conjunto de datos del Titanic. Mostrando, por ejemplo, cómo la mayoría de las mujeres que no sobrevivieron pertenecían a la tercera clase ...)

Me encantaría poder reproducir tal trama con R. ¿Es eso posible?

Gracias tal

Tal Galili
fuente
1
Para ideas sobre gráficos, siempre reviso la galería de gráficos R. Aquí hay algo de allí que es algo parecido a lo que pides: R Graph Gallery paralela . Lo encontré haciendo clic en paralelo en la nube de etiquetas, pero puede haber mejores opciones.
Nick Sabbe
1
Gracias Nick Pero esto no funcionará para datos categóricos sin ajustes importantes del código (probablemente tampoco sea la mejor base de funciones para construir esto). Espero que alguien ya haya hecho algo similar ...
Tal Galili

Respuestas:

25

Aquí hay una versión que usa solo gráficos básicos, gracias al comentario de Hadley. (Para la versión anterior, vea el historial de edición).

tercer intento

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 - Restablece a Monica
fuente
Aaron, wow, respuesta fantástica: desearía poder marcar V dos veces. ¡Gracias!
Tal Galili
2
Me alegra que te guste. Fue divertido. :) La única parte difícil es obtener los lugares donde las barras deberían comenzar y terminar (que está en la getpsubfunción); el resto es solo dibujar polígonos.
Aaron - Restablece a Monica el
1
Solo otra panel.textlínea. Ver editar.
Aaron - Restablece a Monica el
1
También puede hacer transparencias en los gráficos base.
Hadley
2
Estás en lo correcto. Me había olvidado por completo de eso, estando tan acostumbrado a la forma reticular de hacer las cosas. Para otros interesados, agregue un par de caracteres más a su cadena de color, por ejemplo #FF000080. ?rgbTiene detalles.
Aaron - Restablece a Monica el