Multiple Gauge Plots with Facet Wrap

[This article was first published on exploRations in R, and kindly contributed to R-bloggers]. (You can report issue about the content on this page here)
Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.


Intro

Here are some good examples of how to generate gauge plots including multiple gauge plots in R found at stackoverflow. My use case, however, requires the ability to vary the number of plots based on the number of metrics fed into the function without having to adjust the code. Below is such a function that borrows from these examples and leverages ggplot2::facet_wrap.

Gauge Plots with Facet Wrap

My data is captured in a table with a column “pos” for the position of the needle, and “metric” for the name of the metric.

Table 1: Metrics Data
pos metric
94 Metric 1
23 Metric 2
44 Metric 3
57 Metric 4
17 Metric 5
79 Metric 6
5 Metric 7
66 Metric 8

The gauge_plot() function takes three parameters. The first is the two-column data frame that has variables “pos” for the needle position, and “metric” for the name of the metric. The second optional parameter allows you to change the breaks. The final parameter controls the number of columns generated by facet_wrap().

Here is the output that captures the 8 metrics in two columns with the default breaks.

The Code

Here’s the code for the function.

gauge_plot <- function(vals, breaks=c(0,30,70,100), ncol= NULL) {
    require(ggplot2)
    require(dplyr)
    require(tidyr)
    
    if (!is.data.frame(vals)) stop("Vals must be a dataframe")
    if (!dim(vals)[2]==2) stop("Vals must have two columns")
    if (!is.numeric(vals$pos)) stop("Dataframe variable pos must be numeric")
    
    
    # function to generate polygons
    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)))
        df <- data.frame(x,y)
        return(df)
    }
    
    
    # create the segments based on the breaks
    segments <- list()
    seg_names <- tibble(x = c("a", "c", "e"), y = c("b", "d" ,"f"))
    
    for(n in 1:3){
        i <-breaks[n]
        j <-breaks[n+1]
        df <- get_poly(i, j)       
        names(df) <- seg_names[n,]
        segments$df[[n]] <- df
    }

    dfs <- bind_cols(segments)

    # create set of segments for each metric 
    pnt <- tibble()
    for (name in vals$metric){
        pnt[1:nrow(dfs), name] <- name
    }
    
    dfp <- dfs %>% 
        cbind(pnt) %>% 
        pivot_longer(-c(a:f), names_to = "metric") %>% 
        select(-value)
    
    # generate the needles
    needles <- list()
    for(p in 1:nrow(vals)){
        i <-vals$pos[p] - 1
        j <-vals$pos[p] + 1
        r1 <- 0.2
        df <- get_poly(i, j, r1)  
        df$metric <- vals$metric[p]
        needles$df[[p]] <- df
    }
    
    dfn <- bind_rows(needles)
    
    
    # graph
    ggplot()+
        geom_polygon(data=dfp, aes(a,b), fill="red")+
        geom_polygon(data=dfp, aes(c,d), fill="gold")+
        geom_polygon(data=dfp, aes(e,f), fill="forestgreen")+
        geom_polygon(data=dfn, aes(x,y))+
        geom_text(data=as.data.frame(breaks), size=3, fontface="bold", vjust=0,
                  aes(x=1.05*cos(pi*(1-breaks/100)),y=1.05*sin(pi*(1-breaks/100)),label=breaks))+
        geom_text(data=vals, aes(x=0,y=0), label=paste0(vals$pos,"%"), vjust=0, size=4, 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()) +
        facet_wrap(~metric, strip.position = "bottom", ncol = ncol) +
        labs(title = "Multiple Gauge Plots w/ Facet Wrap")
}

To leave a comment for the author, please follow the link and comment on their blog: exploRations in R.

R-bloggers.com offers daily e-mail updates about R news and tutorials about learning R and many other topics. Click here if you're looking to post or find an R/data-science job.
Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.

Never miss an update!
Subscribe to R-bloggers to receive
e-mails with the latest R posts.
(You will not see this message again.)

Click here to close (This popup will not appear again)