Burtin’s Antibiotics visualization in Plotly and R

March 29, 2017
By

(This article was first published on R – Modern Data, and kindly contributed to R-bloggers)

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 on topics such as: Data science, Big Data, R jobs, visualization (ggplot2, Boxplots, maps, animation), programming (RStudio, Sweave, LaTeX, SQL, Eclipse, git, hadoop, Web Scraping) statistics (regression, PCA, time series, trading) and more...



If you got this far, why not subscribe for updates from the site? Choose your flavor: e-mail, twitter, RSS, or facebook...

Comments are closed.

Search R-bloggers


Sponsors

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)