R: creazione di forme personalizzate con ggplot

Question

Full Disclosure: anche questo è stato pubblicato nella mailing list ggplot2. (Aggiornerò se riceverò una risposta)

Sono un po 'perso su questo, ho provato a scherzare con geom_polygon ma i tentativi successivi sembrano peggiori del precedente.

L'immagine che sto cercando di ricreare questo, i colori sono irrilevanti, ma le posizioni sono:

Oltre a creare questo, anche bisogno di essere in grado di identificare ogni elemento con testo.

A questo punto, non mi aspetto una soluzione (anche se sarebbe l'ideale) ma i puntatori o esempi simili sarebbero immensamente utili.

Un'opzione con cui ho giocato era l'hacking scale_shape e l'utilizzo di 1,1 come coords. Ma era bloccato dalla possibilità di aggiungere etichette.

Il motivo per cui sto facendo questo con ggplot, è perché sto generando scorecard su base aziendale per azienda. Questo è solo un grafico in una griglia 4 x 10 di altri grafici (utilizzando pushViewport)

Nota: il livello superiore della piramide potrebbe anche essere un rettangolo di dimensioni simili.

Answer 1

Sembra che sia possibile utilizzare una combinazione di geom_path() e geom_segment() poiché si conosce o si può ragionevolmente ritenere le posizioni delle coordinate per ciascun punto principale del grafico/grafico/oggetto in alto. Forse qualcosa del genere funzionerebbe? Il data.frame che è stato costruito contiene il contorno della forma sopra (ho optato per il rettangolo in alto ... Sono sicuro che potresti trovare un modo semplice per generare i punti per approssimare un cerchio se lo volevi. utilizzare geom_segment() per spartirsi quel grande forma di cui hai bisogno.

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

Qui è la mia soluzione proposta. Creare una serie di dati poligonali, e utilizzare geom_polygon() per tracciare questi. tracciare le etichette di testo con geom_text().

Crea l'ellisse con , nel pacchetto cluster.

Si vuole modificare l'estetica trama togliendo la leggenda, le griglie, le etichette degli assi, ecc

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 una grafica di griglia,

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) 

Inoltre, le finestre di griglia possono essere utilizzate per posizionare oggetti diversi sulla stessa pagina. Per esempio,

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