[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.
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.