Burtin’s Antibiotics visualization in Plotly and R
[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.
In this post, we’ll try to re-create Burtin’s antibiotics visualization using Plotly. The post follows Mike Bostock’s original re-creation in Protovis. See here.
library(plotly)
library(reshape2)
library(dplyr)
# Data
df <- read.csv("https://cdn.rawgit.com/plotly/datasets/5360f5cd/Antibiotics.csv", stringsAsFactors = F)
N <- nrow(df)
# Melting for easier use later on
df$Seq <- 1:N
df <- melt(df, id.vars = c("Bacteria", "Gram", "Seq")) %>% arrange(Seq)
# Angle generation
theta.start <- (5/2)*pi - pi/10
theta.end <- pi/2 + pi/10
theta.range <- seq(theta.start, theta.end, length.out = N * 4 - 1)
dtheta <- diff(theta.range)[1]
# Fine adjustment for larger ticks (black)
inc <- 0.04
# Angles for larger ticks
big_ticks <- theta.range[1:length(theta.range) %% 4 == 0]
big_ticks <- c(theta.range[1] - dtheta, big_ticks, theta.range[length(theta.range)] + dtheta)
# Angles for smaller ticks
small_ticks <- theta.range[1:length(theta.range) %% 4 != 0]
# Set inner and outer radii
inner.radius <- 0.3
outer.radius <- 1
# Set colors
cols <- c("#0a3264","#c84632","#000000")
pos_col <- "rgba(174, 174, 184, .8)"
neg_col <- "rgba(230, 130, 110, .8)"
# Function to calculate radius given minimum inhibitory concentration
# Scaling function is sqrt(log(x))
radiusFUNC <- function(x){
min <- sqrt(log(0.001 * 1e4))
max <- sqrt(log(1000 * 1e4))
a <- (outer.radius - inner.radius)/(min - max)
b <- inner.radius - a * max
rad <- a * sqrt(log(x * 1e4)) + b
return(rad)
}
SEQ <- function(start, by, length){
vec <- c()
vec[1] <- start
for(i in 2:length){
vec[i] <- vec[i-1] + by
}
return(vec)
}
# Generate x and y coordinates for large ticks
radial_gridlines <- data.frame(theta = big_ticks,
x = (inner.radius - inc) * cos(big_ticks),
y = (inner.radius - inc) * sin(big_ticks),
xend = (outer.radius + inc) * cos(big_ticks),
yend = (outer.radius + inc) * sin(big_ticks))
# Generate x and y coordinates for antibiotics
antibiotics <- df
antibiotics$x <- inner.radius * cos(small_ticks)
antibiotics$y <- inner.radius * sin(small_ticks)
antibiotics$xend <- radiusFUNC(df$value) * cos(small_ticks)
antibiotics$yend <- radiusFUNC(df$value) * sin(small_ticks)
antibiotics$text <- with(antibiotics,
paste("<b>Bacteria:</b>", Bacteria, "<br>",
"<b>Antibiotic:</b>", variable, "<br>",
"<b>Min. conc:</b>", value, "<br>"))
# Generate x and y coordinates for white circles (grid)
rad <- c(100, 10, 1, 0.1, 0.01, 0.001)
rad <- c(inner.radius, radiusFUNC(rad))
theta <- seq(0, 2 * pi, length.out = 100)
circles <- lapply(rad, function(x){
x.coord <- x * cos(theta)
y.coord <- x * sin(theta)
return(data.frame(label = which(rad == x),
x = x.coord,
y = y.coord))
})
circles <- do.call(rbind, lapply(circles, data.frame))
# Generate gram-negative polygon
theta <- seq(big_ticks[1], big_ticks[10], length.out = 100)
gram.neg <- data.frame(theta = theta,
x = inner.radius * cos(theta),
y = inner.radius * sin(theta))
theta <- rev(theta)
gram.neg <- rbind(gram.neg,
data.frame(theta = theta,
x = outer.radius * cos(theta),
y = outer.radius * sin(theta)))
# Generate gram-positive polygon
theta <- seq(big_ticks[10], big_ticks[length(big_ticks)], length.out = 100)
gram.pos <- data.frame(theta = theta,
x = inner.radius * cos(theta),
y = inner.radius * sin(theta))
theta <- rev(theta)
gram.pos <- rbind(gram.pos,
data.frame(theta = theta,
x = outer.radius * cos(theta),
y = outer.radius * sin(theta)))
# Text annotations - bacteria name
bacteria.df <- data.frame(bacteria = unique(antibiotics$Bacteria),
theta = big_ticks[-length(big_ticks)] - 0.17,
stringsAsFactors = F)
bacteria.df$x <- (outer.radius + inc) * cos(bacteria.df$theta)
bacteria.df$y <- (outer.radius + inc) * sin(bacteria.df$theta)
bacteria.df$textangle <- SEQ(-70, by = 21, length = nrow(bacteria.df))
bacteria.df$textangle[9:nrow(bacteria.df)] <-
(bacteria.df$textangle[9:nrow(bacteria.df)] - 90) - 90
bacteria.df <- lapply(1:nrow(bacteria.df), function(x){
list(x = outer.radius*cos(bacteria.df$theta[x]) ,
y = outer.radius*sin(bacteria.df$theta[x]),
xref = "plot", yref = "plot",
xanchor = "center", yanchor = "middle",
text = bacteria.df$bacteria[x],
showarrow = F,
font = list(size = 12, family = "arial"),
textangle = bacteria.df$textangle[x])
})
# Title
bacteria.df[[17]] <- list(x = 0, y = 1,
xref = "paper", yref = "paper",
xanchor = "left", yanchor = "top",
text = "<b>Burtin’s Antibiotics</b>",
showarrow = F,
font = list(size = 30, family = "serif"))
# Text annotations - scale
scale.annotate <- data.frame(x = 0,
y = c(inner.radius, radiusFUNC(c(100, 10, 1, 0.1, 0.01, 0.001))),
scale = c("", "100", "10", "1", "0.1", "0.01","0.001"))
# Plot
p <- plot_ly(x = ~x, y = ~y, xend = ~xend, yend = ~yend,
hoverinfo = "text",
height = 900, width = 800) %>%
# Gram negative sector
add_polygons(data = gram.neg,
x = ~x, y = ~y,
line = list(color = "transparent"),
fillcolor = neg_col,
inherit = F,
hoverinfo = "none") %>%
# Gram positive sector
add_polygons(data = gram.pos,
x = ~x, y = ~y,
line = list(color = "transparent"),
fillcolor = pos_col,
inherit = F,
hoverinfo = "none") %>%
# Antibiotics
add_segments(data = antibiotics %>% filter(variable == "Penicillin"),
text = ~text,
line = list(color = cols[1], width = 7)) %>%
add_segments(data = antibiotics %>% filter(variable == "Streptomycin"),
text = ~text,
line = list(color = cols[2], width = 7)) %>%
add_segments(data = antibiotics %>% filter(variable == "Neomycin"),
text = ~text,
line = list(color = cols[3], width = 7)) %>%
# Black large ticks
add_segments(data = radial_gridlines, line = list(color = "black", width = 2),
hoverinfo = "none") %>%
# White circles
add_polygons(data = circles,
x = ~x, y = ~y,
group_by = ~label,
line = list(color = "#eeeeee", width = 1),
fillcolor = "transparent",
inherit = F,
hoverinfo = "none") %>%
# Scale labels
add_text(data = scale.annotate, x = ~x, y = ~y, text = ~scale,
inherit = F,
textfont = list(size = 10, color = "black"),
hoverinfo = "none") %>%
# Gram labels
add_markers(x = c(-0.05, -0.05), y = c(-1.4, -1.5),
marker = list(color = c(neg_col, pos_col), size = 15),
inherit = F, hoverinfo = "none") %>%
add_text(x = c(0.15, 0.15), y = c(-1.4, -1.5), text = c("Gram Negative", "Gram Positive"),
textfont = list(size = 10, color = "black"),
inherit = F, hoverinfo = "none") %>%
# Antibiotic legend
add_markers(x = c(-0.15, -0.15, -0.15), y = c(0.1, 0, -0.1),
marker = list(color = c(cols), size = 15, symbol = "square"),
inherit = F, hoverinfo = "none") %>%
add_text(x = c(0.05, 0.05, 0.05), y = c(0.1, 0, -0.1),
text = c("Penicillin", "Streptomycin", "Neomycin"),
textfont = list(size = 10, color = "black"),
inherit = F, hoverinfo = "none") %>%
layout(showlegend = F,
xaxis = list(showgrid = F, zeroline = F, showticklabels = F, title = "", domain = c(0.05, 0.95)),
yaxis = list(showgrid = F, zeroline = F, showticklabels = F, title = "", domain = c(0.05, 0.95)),
plot_bgcolor = "rgb(240, 225, 210)",
paper_bgcolor = "rgb(240, 225, 210)",
# Annotations
annotations = bacteria.df)
p
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.