Site icon R-bloggers

Bullet Charts in R using Plotly

[This article was first published on R – Modern Data, 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.

This post is inspired by Mike Bostock’s implementation of bullet charts – http://bl.ocks.org/mbostock/4061961

library(plotly)
library(jsonlite)
library(dplyr)

# Read data
df <- fromJSON(txt = url("https://cdn.rawgit.com/plotly/datasets/master/BulletData.json"))

# Convert to conventional format
df <- t(apply(df, 1, function(vec){
  vec <- unlist(vec)
  return(vec)
}))

df <- as.data.frame(df, stringsAsFactors = F)
p <- list()

# Set line widths
innerwidth <- 10
outerwidth <- 25

for(i in 1:nrow(df)){
  p[[i]] <- 
    
    # Ranges3
    plot_ly(df[i,], 
            x = c(0, as.numeric(ranges3)),
            y = c(title, title),
            name = "Range3",
            hoverinfo = "x",
            mode = "lines",
            line = list(color = "#eeeeee", width = outerwidth),
            evaluate = T) %>% 
    
    # Ranges2
    add_trace(x = c(0, as.numeric(ranges2)),
              y = c(title, title),
              hoverinfo = "x",
              mode = "lines",
              line = list(color = "#dddddd", width = outerwidth),
              evaluate = T) %>%
    
    # Ranges1
    add_trace(x = c(0, as.numeric(ranges1)),
              y = c(title, title),
              hoverinfo = "x",
              line = list(color = "#cccccc", width = outerwidth),
              evaluate = T) %>% 
    
    
    # Measure2
    add_trace(x = c(0, as.numeric(measures2)),
              y = c(title, title),
              mode = "lines",
              hoverinfo = "x",
              line = list(color = "#b0c4de", width = innerwidth),
              evaluate = T) %>% 
    
    # Measure1
    add_trace(x = c(0, as.numeric(measures1)),
              y = c(title, title),
              mode = "lines",
              hoverinfo = "x",
              line = list(color = "#4682b4", width = innerwidth),
              evaluate = T) %>% 
    
    # Marker
    add_trace(x = as.numeric(markers),
              y = title,
              mode = "markers",
              hoverinfo = "x",
              marker = list(color = "black", symbol = "diamond-tall", size = 10),
              evaluate = T) %>% 
    
    layout(showlegend = F, 
           xaxis = list(title = "", showgrid = F, zeroline = F, 
                        range = c(-(as.numeric(ranges3)/10), as.numeric(ranges3)),
                        ticklen = 7,
                        tick = list(family = "Arial", size = 10),
                        tickcolor = "#cccccc"),
           
           yaxis = list(title = "",
                        showgrid = F, 
                        zeroline = F,
                        showticklabels = F))
}

pp <- subplot(p[[1]], p[[2]], p[[3]], p[[4]], p[[5]],
        nrows = 5, 
        margin = c(0, 0, 0.1, 0))

# Add Y-Axis titles
pp <- layout(pp,
       annotations = list(
         
         list(xref = "paper", yref = "paper", 
              x = 0, y = 0.05, ax = 0, ay = 0, xanchor = "right",
              text = paste0("<b>", df[1,1], "</b>","<br>",
                            '<span style = "color:grey; -size:75%">', 
                            df[1,2], "</span>"),
              align = "right",
               = list(family = "arial",
                          size = 15)),
         
         list(xref = "paper", yref = "paper", 
              x = 0, y = 0.25, ax = 0, ay = 0, xanchor = "right",
              text = paste0("<b>", df[2,1], "</b>","<br>",
                            '<span style = "color:grey; -size:75%">', 
                            df[2,2], "</span>"),
              align = "right",
               = list(family = "arial",
                          size = 15)),
         
         list(xref = "paper", yref = "paper", 
              x = 0, y = 0.45, ax = 0, ay = 0, xanchor = "right",
              text = paste0("<b>", df[3,1], "</b>","<br>",
                            '<span style = "color:grey; -size:75%">', 
                            df[3,2], "</span>"),
              align = "right",
               = list(family = "arial",
                          size = 15)),
         
         list(xref = "paper", yref = "paper", 
              x = 0, y = 0.65, ax = 0, ay = 0, xanchor = "right",
              text = paste0("<b>", df[4,1], "</b>","<br>",
                            '<span style = "color:grey; -size:75%">', 
                            df[4,2], "</span>"),
              align = "right",
               = list(family = "arial",
                          size = 15)),
         
         list(xref = "paper", yref = "paper", 
              x = 0, y = 0.90, ax = 0, ay = 0, xanchor = "right",
              text = paste0("<b>", df[5,1], "</b>","<br>",
                            '<span style = "color:grey; -size:75%">', 
                            df[5,2], "</span>"),
              align = "right",
               = list(family = "arial",
                          size = 15))))

pp

To leave a comment for the author, please follow the link and comment on their blog: R – Modern Data.

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.