# Is it possible to create “parallel sets” plot using R?

Thanks to Tormod question (posted here) I came across the Parallel Sets plot. Here is an example for how it looks: (It is a visualization of the Titanic dataset. Showing, for example, how most of the women that didn't survive belonged to the third class...)

I would love to be able to reproduce such a plot with R. Is that possible to do?

Thanks, Tal

• For ideas on graphics, I always check the R graph gallery. Here's something from there that is somewhat like what you ask for: R Graph Gallery parallel. I found it by clicking parallel in the tag cloud, but there may be better options. – Nick Sabbe Jun 17 '11 at 11:28
• Thanks Nick. But this will not work for categorical data without major tweaking of the code (it's also probably not the best base of functions to built this with). I hope someone might have done something similar already... – Tal Galili Jun 17 '11 at 12:04

Here's a version using only base graphics, thanks to Hadley's comment. (For previous version, see edit history).

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])
}
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))
}
}
}

data(Titanic)
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, fantastic answer - I wish I could mark it V twice. Thank you! – Tal Galili Jun 17 '11 at 16:23
• Glad you like it. It was fun. :) The only tricky part is getting the places where the bars should start and end (which is in the getp subfunction); the rest is just drawing polygons. – Aaron - Reinstate Monica Jun 17 '11 at 16:26
• Just another panel.text line. See edit. – Aaron - Reinstate Monica Jun 17 '11 at 20:14
• You can do transparency in base graphics too. – hadley Jun 21 '11 at 13:34
• Right you are. I'd completely forgotten about that, being so used to the lattice way of doing things. For others who are interested, you add a couple more characters onto your color string, for example, #FF000080. ?rgb has details. – Aaron - Reinstate Monica Jun 21 '11 at 15:16

Based on @Aaron code I developed something called "alluvial diagram". See http://bc.bojanorama.pl/2014/03/alluvial-diagrams/ Example below: