R: Creación de formas personalizadas con ggplot

Question

Divulgación completa: Esto también se publicó en la lista de distribución de ggplot2. (Actualizaré si recibo una respuesta)

Estoy un poco perdido en este caso, he intentado meterme con geom_polygon pero los intentos sucesivos parecen ser peores que los anteriores.

La imagen que estoy tratando de recrear es esto, los colores no son importantes, pero las posiciones son:

Además de crear esto, también tienen que ser capaces de etiquetar cada elemento con texto.

En este punto, no estoy esperando una solución (aunque sería ideal) pero los punteros o ejemplos similares serían inmensamente útiles.

Una opción con la que jugué fue hackear scale_shape y usar 1,1 como coords. Pero estaba atascado con poder agregar etiquetas.

La razón por la que estoy haciendo esto con ggplot, es porque estoy generando cuadros de mandos compañía por compañía. Esta es solo una parcela en una grilla de 4 x 10 de otras parcelas (usando pushViewport)

Nota: La capa superior de la pirámide también podría ser un rectángulo de tamaño similar.

Answer 1

Parece que podría usar una combinación de geom_path() y geom_segment() ya que sabe o puede estimar razonablemente las ubicaciones de coordenadas para cada punto principal en su gráfico/gráfico/cosaajunto allí. Tal vez algo así podría funcionar? El data.frame que se construyó contiene el contorno de la figura de arriba (opté por el rectángulo en la parte superior ... Estoy seguro de que podría encontrar una manera fácil de generar los puntos para aproximar un círculo si realmente quisiera. utilizar geom_segment() a repartir que forma grande como sea necesario.

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") 

Answer 2

Aquí está mi solución propuesta. Crear una serie de datos de polígono, y el uso de geom_polygon() para trazar estos. trazar las etiquetas de texto con geom_text().

Cree la elipse con ellipsoidhull(), en el paquete cluster.

Usted tendrá que modificar la estética de la trama mediante la eliminación de la leyenda, las líneas de división, etiquetas de los ejes, etc.

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) 

Answer 3

Con gráfico reticulado,

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) 

Además, las ventanas Grid se pueden usar para colocar diferentes objetos en la misma página. Por ejemplo,

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")