How to produce a graphic of stacked planes or overlapping diamonds using R (and ideally ggplot2)?-CodePudding

While looking at upskilling myself, I was watching the really quite excellent

Stacked Planes, with transparencies for most, and labels (appropriately highlighted):

I have been able to produce something similar, using rgl, but it's not nearly as nice. Given I am trying to upskill myself in ggplot2, I would like to be able to produce it using ggplot2 (or one of it's extensions), as that would enable me to control some of the "nicities" of the graphic much easier).

Is this possible using ggplot2 or an extension package?

The code for producing it in rgl is:

library(rgl)
# Create some dummy data
dat <- replicate(2, 1:3)

# Initialize the scene, no data plotted
# hardcoded user matrix of a particular view (so I can go straight to that view each time)
userMatrix_orig <- matrix(c(-0.7069399, -0.2729415, 0.6524867, 0.0000000, 0.7072651, -0.2773000, 0.6502926, 0.0000000, 0.003442926, 0.921199083, 0.389076293, 0.000000000, 0, 0, 0, 1), nrow = 4 )

plot3d(dat, type = 'n', xlim = c(-1, 1), ylim = c(-1, 1), zlim = c(-10, 10), 
       xlab = '', ylab = '', zlab = '', axes=FALSE) 
view3d(userMatrix=userMatrix_orig)
material3d(alpha=1.0)
# Add planes
planes3d(1, 1, 1, -2, col = 'paleturquoise', alpha = 0.8, name="hello")
planes3d(1, 1, 1, -4, col = 'palegreen', alpha = 0.8)
planes3d(1, 1, 1, -6, col = 'palevioletred', alpha = 0.8)
planes3d(1, 1, 1, -8, col = 'midnightblue', alpha = 0.8)
planes3d(1, 1, 1, 0, col = 'red', alpha = 0.8)
planes3d(1, 1, 1, 2, col = 'green', alpha = 0.8)
planes3d(1, 1, 1, 4, col = 'orange', alpha = 0.8)
planes3d(1, 1, 1, 6, col = 'blue', alpha = 0.8)

# Label the planes
family_val <- c("sans")
adj_val <- 1
cex_val <- 2.5
text3d(x=1, y =-1, z = -6, texts="data", adj = adj_val, family = family_val, cex = cex_val )
text3d(x=1, y =-1, z = -4, texts="mapping", adj = adj_val, family = family_val, cex = cex_val )
text3d(x=1, y =-1, z = -2, texts="statistics", adj = adj_val, family = family_val, cex = cex_val )
text3d(x=1, y =-1, z = 0, texts="scales", adj = adj_val, family = family_val, cex = cex_val )
text3d(x=1, y =-1, z = 2, texts="geometries", adj = adj_val, family = family_val, cex = cex_val )
text3d(x=1, y =-1, z = 4, texts="facets", adj = adj_val, family = family_val, cex = cex_val )
text3d(x=1, y =-1, z = 6, texts="coordinates", adj = adj_val, family = family_val, cex = cex_val )
text3d(x=1, y =-1, z = 8, texts="theme", adj = adj_val, family = family_val, cex = cex_val )

and the graphic I produced using that is:

CodePudding user response：

I would recreate the image in ggplot with a function like this:

make_graphic <- function(highlight = 1:8) {
  
  library(ggplot2)
  alpha_vals <- c(0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2)
  
  alpha_vals[highlight] <- 1
  
  df <- data.frame(x = rep(c(0.5, 0.75, 1, 0.75, 0.5), 8),
                   y = rep(c(0.5, 0, 0.5, 1, 0.5), 8)   rep(0:7, each = 5)/2,
                   z = rep(LETTERS[1:8], each = 5))
  
  ggplot(df, aes(x, y))  
    geom_polygon(aes(fill = z, alpha = z))  
    geom_text(data = data.frame(x = 0.48, y = rev(0.5   (0:7)/2),
                                z = rev(LETTERS[1:8]),
                                a = c("THEME", "COORDINATES", "FACETS",
                                      "GEOMETRIES", "SCALES", "STATISTICS", 
                                      "MAPPING", "DATA")), fontface = 2,
              family = "opencondensed",
              aes(label = a, alpha = z), colour = "white", size = 10, hjust = 1)  
    scale_x_continuous(limits = c(0.2, 1))  
    scale_fill_manual(values = c("#a6aaa9", "#ef4e47", "#34a5da", "#ff9d35", 
                                 "#8abe5e", "#ffe989", "#c52060", "#3f969a"))  
    scale_alpha_manual(values = alpha_vals)  
    theme_void()  
    theme(legend.position = "none",
          plot.background = element_rect(fill = "#222222"))
}

This allows the graphic to be recreated easily by doing:

make_graphic()

And if you want to just highlight the second bottom item, you can do:

make_graphic(2)

CodePudding user response：

Here's an attempt.

Data

library(dplyr)
mydata <- data.frame(
  label = c("THEME", "COORDINATES", "FACETS", "GEOMETRIES", "SCALES", "STATISTICS", "MAPPING", "DATA"),
  ybase = 8:1,
  color = c("#3f969a", "#c52060", "#ffe989", "#8abe5e", "#ff9d35", "#34a5da", "#ef4e47", "#a6aaa9")
) %>%
  rowwise() %>%
  mutate(
    xs = list(c(0, 2, 0, -2)),
    ys = lapply(ybase, ` `, c(1.1, 0, -1.1, 0)),
    ord = list(1:4)
  ) %>%
  ungroup() %>%
  tidyr::unnest(c(xs, ys, ord)) %>%
  arrange(ybase, ord)
spldata <- split(mydata, mydata$label)
spldata <- spldata[order(sapply(spldata, function(z) z$ybase[1]))]

The reason I create spldata is because ggplot2 does not (afaik) allow setting the z-order easily, so I will resort (next block) to plotting the polygons iteratively.

Plot, no highlights

library(ggplot2)
ggplot(mydata, aes(xs, ys, group = label))  
  lapply(spldata, function(dat) {
    geom_polygon(aes(fill = I(color)), data = dat)
  })  
  geom_text(aes(x = -2.2, y = ybase, label = label),
            hjust = 1, color = "white", size = 7,
            data = ~ filter(., ord == 1))  
  guides(fill = "none", color = "none", alpha = "none")  
  scale_x_continuous(expand = expansion(add = c(2.5, 0.2)))  
  theme(
    plot.background = element_rect(colour = "black", fill = "black"),
    panel.background = element_rect(colour = "black", fill = "black"),
    panel.grid.major = element_blank(),
    panel.grid.minor = element_blank(),
    axis.text = element_blank(), axis.ticks = element_blank()
  )

Plot, with highlight

The changes here:

add alpha = if ... to geom_polygons
split the geom_text into two calls, since I did not want to found colour= aesthetics between polygons and texts

this <- c("THEME", "MAPPING")
ggplot(mydata, aes(xs, ys, group = label))  
  lapply(spldata, function(dat) {
    geom_polygon(aes(fill = I(color)),
                 alpha = if (dat$label[1] %in% this) 1 else 0.2,
                 data = dat)
  })  
  {
    if (any(!mydata$label %in% this))
      geom_text(aes(x = -2.2, y = ybase, label = label),
                hjust = 1, color = "gray50", size = 7,
                data = ~ filter(., ord == 1, !label %in% this))
  }  
  {
    if (any(this %in% mydata$label))
      geom_text(aes(x = -2.2, y = ybase, label = label),
                hjust = 1, color = "white", size = 7,
                data = ~ filter(., ord == 1, label %in% this))
  }  
  guides(fill = "none", color = "none", alpha = "none")  
  scale_x_continuous(expand = expansion(add = c(2.5, 0.2)))  
  theme(
    plot.background = element_rect(colour = "#222222", fill = "#222222"),
    panel.background = element_rect(colour = "#222222", fill = "#222222"),
    panel.grid.major = element_blank(),
    panel.grid.minor = element_blank(),
    axis.text = element_blank(), axis.ticks = element_blank()
  )

(I borrowed From AllanCameron the idea of "one or more" for this in order to be able to highlight more than one (or perhaps none).

CodePudding user response：

After working on it a while myself, I came up with the following method:

library(ggplot2)

# Make a diamond polygon specification in a data frame programatically
# See: https://stackoverflow.com/a/51643354/9861107
diamond <- function(side_length, centre) {
  base <- matrix(c(1, 0, 0, 1, -1, 0, 0, -1), nrow = 2) * sqrt(2) / 2
  trans <- (base * side_length)   centre
  as.data.frame(t(trans))
}

# parameterise our variables
alpha_highlight <- 1.0
alpha_mute <- 0.2
font_size <- 8
font_weight <- "bold"
font_colour <- "White"
background_color <- "black"
#font_colour <- "black"
#background_color <- "transparent"

# produce a data table
dt <- data.table(side_lengths = rep(c(2),8),
                 centres = matrix(c(1   rep(0,8),2   0:7),nrow=8),
                 colours = c('grey','blue','red','orange','paleturquoise','palegreen','palevioletred','midnightblue'),
                 labels = c('DATA','MAPPING','STATISTICS','SCALES','GEOMETRIES','FACETS','COORDINATES','THEMES'),
                 highlights = c(FALSE,FALSE,TRUE,TRUE,FALSE,FALSE,FALSE,TRUE))

# calculate the alphas using the highlights column along with our parameters
# takes advantage of the fact TRUE is coerced to 1.0 and FALSE is coerced to 0.0
dt[,alphas:=(as.numeric(highlights)*alpha_highlight   as.numeric(!highlights)*alpha_mute)]

# produce the plot
ggplot()   lapply(c(1:8),function(x) {geom_polygon(data = diamond(dt$side_lengths[x], c(dt$centres.V1[x],dt$centres.V2[x])), mapping = aes(x = V1, y = V2), fill = dt$colours[x], alpha = dt$alphas[x])})  
  lapply(c(1:8),function(z) {annotate("text", x = -(dt$centres.V1[z]/2)*1.1, y = dt$centres.V2[z], label = dt$labels[z], alpha = dt$alphas[z], size=font_size, 
                                      fontface = font_weight, hjust=1, colour=font_colour)})   
  coord_cartesian(xlim = c(-2,3), ylim =c(-1,12))   # set the bounding box to the view. Could be parameterised into a function.
  theme_void()   # get rid of the default theming
  theme( plot.background = element_rect(fill = background_color) ) # set the background colour based on our parameter

which produces:

The data table can be easily edited to focus on which layers should be highlighted. An extension would be to turn this into a function (much like @AllenCameron's excellent answer), enabling the individual parameterisations to be performed programatically (like the number of rows etc)