R: Создание пользовательских фигур с помощью ggplot

Question

Полное раскрытие: это также было опубликовано в списке рассылки ggplot2. (Я буду обновлять, если я получу ответ)

Я немного растерялся, я пытался возиться с geom_polygon, но последовательные попытки кажутся хуже, чем предыдущие.

Изображение, которое я пытаюсь воссоздать, таково, цвета не важны, но позиции:

В дополнение к этому, мне также нужно иметь возможность пометить каждый элемент текстом.

На данный момент я не ожидаю решения (хотя это было бы идеально), но указатели или подобные примеры были бы чрезвычайно полезны.

Один из вариантов, с которым я играл, был взломом scale_shape и использованием 1,1 в качестве координат. Но застрял в возможности добавлять ярлыки.

Причина, по которой я делаю это с помощью ggplot, заключается в том, что я создаю системы показателей для каждой компании. Это только один график в сетке 4 x 10 других графиков (с использованием pushViewport)

Примечание: верхний ярус пирамиды также может быть прямоугольником аналогичного размера.

Answer 1

Вот мое предлагаемое решение.Создайте серию данных многоугольника и используйте geom_polygon() для их построения.Нанесите текстовые метки с помощью geom_text().

. Создайте эллипс с ellipsoidhull() в пакете cluster.

. Вы захотите изменить эстетику сюжета, удалив условные обозначения, линии сетки, метки осей и т. д.

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 2

С сеточной графикой,

 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)

Кроме того, видовые окна сетки можно использовать для размещения различных объектов на одной странице. Например,

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

Answer 3

Похоже, что вы могли бы использовать комбинацию geom_path() и geom_segment(), поскольку вы либо знаете, либо можете разумно угадать местоположения координат для каждой основной точки на вашем графике / диаграмме / thingamajigger наверху.Может быть, что-то подобное будет работать?Построенный файл data.frame содержит контур вышеприведенной фигуры (я выбрал прямоугольник сверху ... Я уверен, что вы могли бы найти простой способ создания точек для аппроксимации круга, если вы действительно этого хотите. Затемиспользуйте geom_segment(), чтобы разделить эту большую форму, как вам нужно.

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