如何在R中绘制仪表图?

Man*_*ish 13 charts r gauge

我如何在R中绘制下图?

  Red = 30
  Yellow = 40
  Green = 30 

  Needle at 52. 
Run Code Online (Sandbox Code Playgroud)

请帮助我,因为我非常需要.

谢谢

在此输入图像描述

jlh*_*ard 28

所以这是一个完全ggplot解决方案.

注意:从原始帖子编辑,在规格中断处添加数字指示符和标签,这似乎是OP在评论中要求的.如果不需要指示,请删除该annotate(...)行.如果不需要标签,请删除geom_text(...)行.

gg.gauge <- function(pos,breaks=c(0,30,70,100)) {
  require(ggplot2)
  get.poly <- function(a,b,r1=0.5,r2=1.0) {
    th.start <- pi*(1-a/100)
    th.end   <- pi*(1-b/100)
    th       <- seq(th.start,th.end,length=100)
    x        <- c(r1*cos(th),rev(r2*cos(th)))
    y        <- c(r1*sin(th),rev(r2*sin(th)))
    return(data.frame(x,y))
  }
  ggplot()+ 
    geom_polygon(data=get.poly(breaks[1],breaks[2]),aes(x,y),fill="red")+
    geom_polygon(data=get.poly(breaks[2],breaks[3]),aes(x,y),fill="gold")+
    geom_polygon(data=get.poly(breaks[3],breaks[4]),aes(x,y),fill="forestgreen")+
    geom_polygon(data=get.poly(pos-1,pos+1,0.2),aes(x,y))+
    geom_text(data=as.data.frame(breaks), size=5, fontface="bold", vjust=0,
              aes(x=1.1*cos(pi*(1-breaks/100)),y=1.1*sin(pi*(1-breaks/100)),label=paste0(breaks,"%")))+
    annotate("text",x=0,y=0,label=pos,vjust=0,size=8,fontface="bold")+
    coord_fixed()+
    theme_bw()+
    theme(axis.text=element_blank(),
          axis.title=element_blank(),
          axis.ticks=element_blank(),
          panel.grid=element_blank(),
          panel.border=element_blank()) 
}
gg.gauge(52,breaks=c(0,35,70,100))
Run Code Online (Sandbox Code Playgroud)

## multiple guages
library(gridExtra)
grid.newpage()
grid.draw(arrangeGrob(gg.gauge(10),gg.gauge(20),
                      gg.gauge(52),gg.gauge(90),ncol=2))
Run Code Online (Sandbox Code Playgroud)

你可能需要调整size=...参数geom_text(...),并annotate(...)根据您的仪表的实际大小.

IMO段标签是一个非常糟糕的主意:它们使图像混乱并破坏了图形的目的(一目了然地指示度量标准是在"安全","警告"还是"危险"区域).


MrF*_*ick 9

这是使用网格图形的非常快速和脏的实现

library(grid)

draw.gauge<-function(x, from=0, to=100, breaks=3, 
    label=NULL, axis=TRUE, cols=c("red","yellow","green")) {

    if (length(breaks)==1) {
        breaks <- seq(0, 1, length.out=breaks+1)
    } else {
        breaks <- (breaks-from)/(to-from)
    }
    stopifnot(length(breaks) == (length(cols)+1))

    arch<-function(theta.start, theta.end, r1=1, r2=.5, col="grey", n=100) {
        t<-seq(theta.start, theta.end, length.out=n)
        t<-(1-t)*pi
        x<-c(r1*cos(t), r2*cos(rev(t)))
        y<-c(r1*sin(t), r2*sin(rev(t)))
        grid.polygon(x,y, default.units="native", gp=gpar(fill=col))
    }
    tick<-function(theta, r, w=.01) {
        t<-(1-theta)*pi
        x<-c(r*cos(t-w), r*cos(t+w), 0) 
        y<-c(r*sin(t-w), r*sin(t+w), 0) 
        grid.polygon(x,y, default.units="native", gp=gpar(fill="grey"))
    }
    addlabel<-function(m, theta, r) {
        t<-(1-theta)*pi      
        x<-r*cos(t)
        y<-r*sin(t) 
        grid.text(m,x,y, default.units="native")
    }

    pushViewport(viewport(w=.8, h=.40, xscale=c(-1,1), yscale=c(0,1)))
    bp <- split(t(embed(breaks, 2)), 1:2)
    do.call(Map, list(arch, theta.start=bp[[1]],theta.end=bp[[2]], col=cols))
    p<-(x-from)/(to-from)
    if (!is.null(axis)) {
            if(is.logical(axis) && axis) {
            m <- round(breaks*(to-from)+from,0)
            } else if (is.function(axis)) {
            m <- axis(breaks, from, to)
            } else if(is.character(axis)) {
            m <- axis
            } else {
                   m <- character(0)
            }
        if(length(m)>0) addlabel(m, breaks, 1.10)
    }
    tick(p, 1.03)
    if(!is.null(label)) {
            if(is.logical(label) && label) {
            m <- x
            } else if (is.function(label)) {
            m <- label(x)
            } else {
            m <- label
            }
            addlabel(m, p, 1.15)
    }
    upViewport()
}
Run Code Online (Sandbox Code Playgroud)

此功能可用于绘制一个仪表

grid.newpage()
draw.gauge(100*runif(1))
Run Code Online (Sandbox Code Playgroud)

或许多仪表

grid.newpage()
pushViewport(viewport(layout=grid.layout(2,2)))
for(i in 1:4) {
    pushViewport(viewport(layout.pos.col=(i-1) %/%2 +1, layout.pos.row=(i-1) %% 2 + 1))
    draw.gauge(100*runif(1))
    upViewport()
}
popViewport()
Run Code Online (Sandbox Code Playgroud)

这不是太花哨,所以应该很容易定制.

在此输入图像描述

您现在还可以添加标签

draw.gauge(75, label="75%")
Run Code Online (Sandbox Code Playgroud)

在此输入图像描述

我添加了另一个更新以允许绘制"轴".您可以将其设置为TRUE以使用默认值,或者您可以传入一个字符向量来提供您想要的任何标签,或者您可以传入一个将中断(缩放0-1)和from/to值的函数并应返回一个字符值.

grid.newpage()
draw.gauge(100*runif(1), breaks=c(0,30,70,100), axis=T)
Run Code Online (Sandbox Code Playgroud)

在此输入图像描述