创建自定义形状

Question

我对此有点迷失，我尝试过使用 geom_polygon 但连续的尝试似乎比前一次更糟糕。

我试图重新创建的图像是这样的，颜色并不重要，但位置是：

除了创建它之外，我还需要能够用文本标记每个元素。

在这一点上，我并不期待一个解决方案（尽管这将是理想的），但指针或类似的示例将非常有帮助。

我使用的一种选择是修改scale_shape并使用1,1作为坐标。但一直坚持添加标签。

我使用 ggplot 执行此操作的原因是因为我正在逐个公司生成记分卡。这只是其他绘图的 4 x 10 网格中的一个绘图（使用 PushViewport）

注意：金字塔的顶层也可以是类似大小的矩形。

完全披露：这也发布到 ggplot2 邮件列表中。 （如果收到回复我会更新）

Answer 1

这是我提出的解决方案。创建一系列多边形数据，并使用geom_polygon()来绘制它们。使用geom_text()绘制文本标签。

使用 cluster 包中的 ellipsoidhull() 创建椭圆。

您需要通过删除图例、网格线、轴标签等来修改绘图美观性。

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

---

编辑： qplot() 在 ggplot2 3.4.0 中已弃用。使用 ggplot aes 的相同代码：

ggplot(data = df,aes(x, y, group = group)) +
  geom_path() +
  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")