13

Full Disclosure: This was also posted to the ggplot2 mailing list. (I'll update if I receive a response)

I'm a bit lost on this one, I've tried messing around with geom_polygon but successive attempts seem worse than the previous.

The image that I'm trying to recreate is this, the colours are unimportant, but the positions are:

enter image description here

In addition to creating this, I also need to be able to label each element with text.

At this point, I'm not expecting a solution (although that would be ideal) but pointers or similar examples would be immensely helpful.

One option that I played with was hacking scale_shape and using 1,1 as coords. But was stuck with being able to add labels.

The reason I'm doing this with ggplot, is because I'm generating scorecards on a company by company basis. This is only one plot in a 4 x 10 grid of other plots (using pushViewport)

Note: The top tier of the pyramid could also be a rectangle of similar size.

Brandon Bertelsen
  • 43,807
  • 34
  • 160
  • 255
  • Do you really want to do this with R? What I don't understand is the underlying motivation... stuff like this can easily be made with vector graphics programs, and you should only insist on R if you're willing to do this programatically and/or for showing off. =) Otherwise, approaches like these just don't make any sense... – aL3xa Feb 07 '11 at 03:20
  • The rest of the scorecard is done totally (and automatically) with R. And this is really the last piece. So, leaving R to individually create these graphics is possible, but would be painful. Hence, why I ask first - do bitch work second. – Brandon Bertelsen Feb 07 '11 at 03:32
  • For the ellipse, this might help: http://stackoverflow.com/questions/2397097/how-can-a-data-ellipse-be-superimposed-on-a-ggplot2-scatterplot and https://github.com/JoFrhwld/FAAV/blob/master/r/stat-ellipse.R – Etienne Low-Décarie Apr 26 '12 at 11:52

3 Answers3

20

Here is my proposed solution. Create a series of polygon data, and use geom_polygon() to plot these. Plot the text labels with geom_text().

Create the ellipse with ellipsoidhull(), in the cluster package.

You will want to modify the plot aesthetics by removing the legend, gridlines, axis labels, etc.

enter image description here

library(ggplot2)
library(cluster)

mirror <- function(poly){
    m <- poly
    m$x <- -m$x
    m
}

poly_br <- data.frame(
        x=c(0, 4, 3, 0),
        y=c(0, 0, 1, 1),
        fill=rep("A", 4)
)


poly_mr <- data.frame(
        x=c(0, 3, 2, 0),
        y=c(1, 1, 2, 2),
        fill=rep("B", 4)
)

poly_tr <- data.frame(
        x=c(0.5, 2, 1, 0.5),
        y=c(2, 2, 3, 3),
        fill=rep("C", 4)
)

poly_tm <- data.frame(
        x=c(-0.5, 0.5, 0.5, -0.5),
        y=c(2, 2, 3, 3),
        fill=rep("D", 4)
        )

poly_bl <- mirror(poly_br)
poly_ml <- mirror(poly_mr)
poly_tl <- mirror(poly_tr)


get_ellipse <- function(data, fill){
    edata <- as.matrix(data)
    ehull <- ellipsoidhull(edata)
    phull <- as.data.frame(predict(ehull))
    data.frame(
            x=phull$V1, 
            y=phull$y, 
            fill=rep(fill, nrow(phull))
    )
}

ellipse <- get_ellipse(
        data.frame(
                x=c(0, 2, 0, -2),
                y=c(3, 3.5, 4, 3.5)
    ), fill="E"
)

text <- data.frame(
        x=c(2, -2, 1.5, -1.5, 1.25, -1.25, 0, 0),
        y=c(0.5, 0.5, 1.5, 1.5, 2.5, 2.5, 2.5, 3.5),
        text=c("br", "bl", "mr", "ml", "tr", "tl", "tm", "ellipse"))


poly <- rbind(poly_br, poly_bl, poly_mr, poly_ml, poly_tr, poly_tm, poly_tl, ellipse)


p <- ggplot() + 
        geom_polygon(data=poly, aes(x=x, y=y, fill=fill), colour="black") +
        geom_text(data=text, aes(x=x, y=y, label=text))
print(p)
Andrie
  • 176,377
  • 47
  • 447
  • 496
13

With grid graphics,

 library(grid)

 ellipse <- function (x = 0, y = 0, a=1, b=1,
                      angle = pi/3, n=300) 
 {

   cc <- exp(seq(0, n) * (0+2i) * pi/n) 

   R <- matrix(c(cos(angle), sin(angle),
                 -sin(angle), cos(angle)), ncol=2, byrow=T)

   res <- cbind(x=a*Re(cc), y=b*Im(cc)) %*% R
   data.frame(x=res[,1]+x,y=res[,2]+y)
 }


 pyramidGrob <- function(labels = c("ellipse", paste("cell",1:7)),
                         slope=5,
                         width=1, height=1,
                         fills=c(rgb(0, 113, 193, max=256),
                           rgb(163, 163, 223, max=256),
                           rgb(209, 210, 240, max=256),
                           rgb(217, 217, 217, max=256)), ...,
                         draw=FALSE){

   a <- 0.4
   b <- 0.14
   ye <- 3/4 + b*sin(acos((3/4 / slope-0.5)/a))
   e <- ellipse(0.5, ye, a=a, b=b,angle=0)
   g1 <- polygonGrob(e$x, e$y, gp=gpar(fill=fills[1]))

   x1 <- c(0, 0.5, 0.5, 1/4 / slope, 0)
   y1 <- c(0, 0, 1/4, 1/4, 0)

   x2 <- c(1/4 / slope, 0.5, 0.5, 1/2 / slope, 1/4/slope)
   y2 <- y1 + 1/4

   x3 <- c(1/2 / slope, 0.5, 0.5, 3/4 / slope,  1/2/slope)
   y3 <- y2 + 1/4

   x4 <- c(0.5 - 3/4/slope, 0.5 + 3/4/slope,
           0.5 + 3/4 / slope, 0.5 - 3/4/slope,
           0.5 - 3/4/slope)

   y4 <- y3

   d <- data.frame(x = c(x1,1-x1,x2,1-x2,x3,1-x3,x4),
                   y = c(y1,y1,y2,y2,y3,y3,y4),
                   id = rep(seq(1,7), each=5))

   g2 <- with(d, polygonGrob(x, y, id,
                   gp=gpar(fill=fills[c(rep(2:4,each=2),4)])))

   x5 <- c(0.5, 0.25, 0.25, 0.25, 0.75, 0.75, 0.75, 0.5)
   y5 <- c(3/4+1/8, 1/8, 1/2 - 1/8, 1/2 + 1/8,
           1/8, 1/2 - 1/8, 1/2 + 1/8, 1/2 + 1/8)

   g3 <- textGrob(labels, x5,y5, vjust=1)
   g <- gTree(children=gList(g1,g2,g3), ...,
              vp=viewport(width=width,height=height))

   if(draw) grid.draw(g)
   invisible(g)
 }


 grid.newpage()

 ## library(gridExtra)
 source("http://gridextra.googlecode.com/svn/trunk/R/arrange.r")

 grid.arrange(pyramidGrob(height=0.4),
              pyramidGrob(),
              pyramidGrob(width=0.5),ncol=2)

screenshot

Further, Grid viewports can be used to place different objects on the same page. For instance,

library(gridExtra)


grid.arrange(tableGrob(head(iris)[,1:3]),
           pyramidGrob(), qplot(1:10,1:10),
           lattice::xyplot(1:10~1:10), ncol=2, 
           main = "arrangement of Grid elements")

screenshot2

baptiste
  • 75,767
  • 19
  • 198
  • 294
  • This one looks great, my only concern is that it uses grid, and I'm already using grid to place other elements on the score card (7 other plots to be exact). How would I save this to one variable for placement within a grid of existing plots? – Brandon Bertelsen Feb 09 '11 at 17:52
  • 1
    you can mix arbitrary elements in a page provided they are all based on grid graphics, like my example here. In particular, you can easily place side-by-side grid grobs, ggplot or lattice graphs using grid viewports. grid.arrange() does just that, for rectangular layouts. Please provide a more complete description of your project if you need more details. – baptiste Feb 09 '11 at 17:59
9

It seems like you could use a combination of geom_path() and geom_segment() since you either know or can reasonably guesstimate the coordinate locations for each major point on your graph/chart/thingamajigger up there. Maybe something like this would work? The data.frame that was constructed contains the outline of the shape above (I opted for the rectangle at the top...I'm sure you could find an easy way to generate the points to approximate a circle if you really wanted. Then use geom_segment() to divvy up that large shape as you need. 

df <- data.frame(
    x = c(-8,-4,4,8,-8, -8, -8, 8, 8, -8)
    , y = c(0,18,18,0,0, 18, 22, 22, 18, 18)
    , group = c(rep(1,5), rep(2,5)))

qplot(x,y, data = df, geom = "path", group = group)+
    geom_segment(aes(x = 0, y = 0, xend = 0, yend = 12 )) +
    geom_segment(aes(x = -6.75, y = 6, xend = 6.75, yend = 6)) +
    geom_segment(aes(x = -5.25, y = 12, xend = 5.25, yend = 12)) +
    geom_segment(aes(x = -2, y = 12, xend = -2, yend = 18)) + 
    geom_segment(aes(x = 2, y = 12, xend = 2, yend = 18)) + 
    geom_text(aes(x = -5, y = 2.5), label = "hi world")
Chase
  • 67,710
  • 18
  • 144
  • 161