How to draw gauge chart in R?

Question

How can i draw a following plot in R?

  Red = 30
  Yellow = 40
  Green = 30 

  Needle at 52. 

Pls help me out as i am in great need.

Answer 1

Flexdashboard has a simple function for guage chart. For details take a look at https://rdrr.io/cran/flexdashboard/man/gauge.html

You can plot the chart using a simple call like:

gauge(42, min = 0, max = 100, symbol = '%', 
gaugeSectors(success = c(80, 100), warning = c(40, 79), danger = c(0, 39)))

Answer 2

I found this solution from Gaston Sanchez's blog:

library(googleVis)

plot(gvisGauge(data.frame(Label=”UserR!”, Value=80),
options=list(min=0, max=100,
yellowFrom=80, yellowTo=90,
redFrom=90, redTo=100)))

Here is the function created later:

# Original code by Gaston Sanchez   http://www.r-bloggers.com/gauge-chart-in-r/
#
dial.plot <- function(label = "UseR!", value = 78, dial.radius = 1
          , value.cex = 3, value.color = "black"
          , label.cex = 3, label.color = "black"
          , gage.bg.color = "white"
          , yellowFrom = 75, yellowTo = 90, yellow.slice.color = "#FF9900"
          , redFrom = 90, redTo = 100, red.slice.color = "#DC3912"
          , needle.color = "red", needle.center.color = "black", needle.center.cex = 1
          , dial.digets.color = "grey50"
          , heavy.border.color = "gray85", thin.border.color = "gray20", minor.ticks.color = "gray55", major.ticks.color = "gray45") {

  whiteFrom = min(yellowFrom, redFrom) - 2
  whiteTo = max(yellowTo, redTo) + 2

  # function to create a circle
  circle <- function(center=c(0,0), radius=1, npoints=100)
  {
    r = radius
    tt = seq(0, 2*pi, length=npoints)
    xx = center[1] + r * cos(tt)
    yy = center[1] + r * sin(tt)
    return(data.frame(x = xx, y = yy))
  }

  # function to get slices
  slice2xy <- function(t, rad)
  {
    t2p = -1 * t * pi + 10*pi/8
    list(x = rad * cos(t2p), y = rad * sin(t2p))
  }

  # function to get major and minor tick marks
  ticks <- function(center=c(0,0), from=0, to=2*pi, radius=0.9, npoints=5)
  {
    r = radius
    tt = seq(from, to, length=npoints)
    xx = center[1] + r * cos(tt)
    yy = center[1] + r * sin(tt)
    return(data.frame(x = xx, y = yy))
  }

  # external circle (this will be used for the black border)
  border_cir = circle(c(0,0), radius=dial.radius, npoints = 100)

  # open plot
  plot(border_cir$x, border_cir$y, type="n", asp=1, axes=FALSE,
       xlim=c(-1.05,1.05), ylim=c(-1.05,1.05),
       xlab="", ylab="")

  # gray border circle
  external_cir = circle(c(0,0), radius=( dial.radius * 0.97 ), npoints = 100)
    # initial gage background
  polygon(external_cir$x, external_cir$y,
          border = gage.bg.color, col = gage.bg.color, lty = NULL)

  # add gray border
  lines(external_cir$x, external_cir$y, col=heavy.border.color, lwd=18)
  # add external border
  lines(border_cir$x, border_cir$y, col=thin.border.color, lwd=2)

  # yellow slice (this will be used for the yellow band)
  yel_ini = (yellowFrom/100) * (12/8)
  yel_fin = (yellowTo/100) * (12/8)
  Syel = slice2xy(seq.int(yel_ini, yel_fin, length.out = 30), rad= (dial.radius * 0.9) )
  polygon(c(Syel$x, 0), c(Syel$y, 0),
          border = yellow.slice.color, col = yellow.slice.color, lty = NULL)

  # red slice (this will be used for the red band)
  red_ini = (redFrom/100) * (12/8)
  red_fin = (redTo/100) * (12/8)
  Sred = slice2xy(seq.int(red_ini, red_fin, length.out = 30), rad= (dial.radius * 0.9) )
  polygon(c(Sred$x, 0), c(Sred$y, 0),
          border = red.slice.color, col = red.slice.color, lty = NULL)

  # white slice (this will be used to get the yellow and red bands)
  white_ini = (whiteFrom/100) * (12/8)
  white_fin = (whiteTo/100) * (12/8)
  Swhi = slice2xy(seq.int(white_ini, white_fin, length.out = 30), rad= (dial.radius * 0.8) )
  polygon(c(Swhi$x, 0), c(Swhi$y, 0),
          border = gage.bg.color, col = gage.bg.color, lty = NULL)

  # calc and plot minor ticks
  minor.tix.out <- ticks(c(0,0), from=5*pi/4, to=-pi/4, radius=( dial.radius * 0.89 ), 21)
  minor.tix.in <- ticks(c(0,0), from=5*pi/4, to=-pi/4, radius=( dial.radius * 0.85 ), 21)
  arrows(x0=minor.tix.out$x, y0=minor.tix.out$y, x1=minor.tix.in$x, y1=minor.tix.in$y,
         length=0, lwd=2.5, col=minor.ticks.color)

  # coordinates of major ticks (will be plotted as arrows)
  major_ticks_out = ticks(c(0,0), from=5*pi/4, to=-pi/4, radius=( dial.radius * 0.9 ), 5)
  major_ticks_in = ticks(c(0,0), from=5*pi/4, to=-pi/4, radius=( dial.radius * 0.77 ), 5)
  arrows(x0=major_ticks_out$x, y0=major_ticks_out$y, col=major.ticks.color,
         x1=major_ticks_in$x, y1=major_ticks_in$y, length=0, lwd=3)

  # calc and plot numbers at major ticks
  dial.numbers <- ticks(c(0,0), from=5*pi/4, to=-pi/4, radius=( dial.radius * 0.70 ), 5)
  dial.lables <- c("0", "25", "50", "75", "100")
  text(dial.numbers$x, dial.numbers$y, labels=dial.lables, col=dial.digets.color, cex=.8)


  # Add dial lables
  text(0, (dial.radius * -0.65), value, cex=value.cex, col=value.color)
  # add label of variable
  text(0, (dial.radius * 0.43), label, cex=label.cex, col=label.color)

  # add needle
  # angle of needle pointing to the specified value
  val = (value/100) * (12/8)
  v = -1 * val * pi + 10*pi/8 # 10/8 becuase we are drawing on only %80 of the cir
  # x-y coordinates of needle
  needle.length <- dial.radius * .67
  needle.end.x = needle.length * cos(v)
  needle.end.y = needle.length * sin(v)

  needle.short.length <- dial.radius * .1
  needle.short.end.x = needle.short.length * -cos(v)
  needle.short.end.y = needle.short.length * -sin(v)

  needle.side.length <- dial.radius * .05
  needle.side1.end.x = needle.side.length * cos(v - pi/2) 
  needle.side1.end.y = needle.side.length * sin(v - pi/2)
  needle.side2.end.x = needle.side.length * cos(v + pi/2) 
  needle.side2.end.y = needle.side.length * sin(v + pi/2)

  needle.x.points <- c(needle.end.x, needle.side1.end.x, needle.short.end.x, needle.side2.end.x)
  needle.y.points <- c(needle.end.y, needle.side1.end.y, needle.short.end.y, needle.side2.end.y)
  polygon(needle.x.points, needle.y.points, col=needle.color)

  # add central blue point
  points(0, 0, col=needle.center.color, pch=20, cex=needle.center.cex)
  # add values 0 and 100
}


par(mar=c(0.2,0.2,0.2,0.2), bg="black", mfrow=c(2,2))

dial.plot ()
dial.plot (label = "Working", value = 25, dial.radius = 1
      , value.cex = 3.3, value.color = "white"
      , label.cex = 2.7, label.color = "white"
      , gage.bg.color = "black"
      , yellowFrom = 73, yellowTo = 95, yellow.slice.color = "gold"
      , redFrom = 95, redTo = 100, red.slice.color = "red"
      , needle.color = "red", needle.center.color = "white", needle.center.cex = 1
      , dial.digets.color = "white"
      , heavy.border.color = "white", thin.border.color = "black", minor.ticks.color = "white", major.ticks.color = "white")


dial.plot (label = "caffeine", value = 63, dial.radius = .7
           , value.cex = 2.3, value.color = "white"
           , label.cex = 1.7, label.color = "white"
           , gage.bg.color = "black"
           , yellowFrom = 80, yellowTo = 93, yellow.slice.color = "gold"
           , redFrom = 93, redTo = 100, red.slice.color = "red"
           , needle.color = "red", needle.center.color = "white", needle.center.cex = 1
           , dial.digets.color = "white"
           , heavy.border.color = "black", thin.border.color = "lightsteelblue4", minor.ticks.color = "orange", major.ticks.color = "tan")


dial.plot (label = "Fun", value = 83, dial.radius = .7
           , value.cex = 2.3, value.color = "white"
           , label.cex = 1.7, label.color = "white"
           , gage.bg.color = "black"
           , yellowFrom = 20, yellowTo = 75, yellow.slice.color = "olivedrab"
           , redFrom = 75, redTo = 100, red.slice.color = "green"
           , needle.color = "red", needle.center.color = "white", needle.center.cex = 1
           , dial.digets.color = "white"
           , heavy.border.color = "black", thin.border.color = "lightsteelblue4", minor.ticks.color = "orange", major.ticks.color = "tan")

Answer 3

Here's a very quick and dirty implementation using grid graphics

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()
}

This function can be used to draw one gauge

grid.newpage()
draw.gauge(100*runif(1))

or many gauges

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

It's not too fancy so it should be easy to customize.

You can now also add a label

draw.gauge(75, label="75%")

I've added another update to allow for drawing an "axis". You can set it to TRUE to use default values, or you can pass in a character vector to give whatever labels you want, or you can pass in a function that will take the breaks (scaled 0-1) and the from/to values and should return a character value.

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

Answer 4

So here's a fully ggplot solution.

Note: Edited from the original post to add numeric indicator and labels at the gauge breaks which seems to be what OP is asking for in their comment. If indicator is not needed, remove the annotate(...) line. If labels are not needed, remove geom_text(...) line.

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

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

You will likely need to tweak the size=... parameter to geom_text(...) and annotate(...) depending on the actual size of your gauge.

IMO the segment labels are a really bad idea: they clutter the image and defeat the purpose of the graphic (to indicate at a glance if the metric is in "safe", "warning", or "danger" territory).