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.

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("Bacteria:", Bacteria, "
", "Antibiotic:", variable, "
", "Min. conc:", value, "
")) # 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 = "Burtin’s Antibiotics", 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.

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)