Volcano plot with the ability to query snp codes

volcano-plot-snp.R

# install.packages("plotly")

library(plotly)
library(htmlwidgets)

# grab some fake data from manhattanly
# note this is a data.frame!
# you can convert a matrix to a data frame with as.data.frame()
download.file("https://github.com/sahirbhatnagar/manhattanly/raw/master/data/HapMap.rda", "HapMap.rda")
load("HapMap.rda")
str(HapMap)

vline <- function(x = 1) {
  list(
    type = "line",
    x1 = x, x0 = x, xref = "x", 
    y0 = 0, y1 = 1, yref = "paper",
    line = list(dash = "dash")
  )
}

hline <- function(y = 4) {
  list(
    type = "line", 
    y0 = y, y1 = y, yref = "y",
    x1 = 0, x0 = 1, xref = "paper",
    line = list(dash = "dash")
  )
}


HapMap %>%
  mutate(P2 = -log10(P)) %>%
  plot_ly(
    x = ~EFFECTSIZE, y = ~ P2, text = ~SNP, hoverinfo = "text",
    customdata = ~paste0("https://www.ncbi.nlm.nih.gov/snp/?term=", SNP)
  ) %>%
  add_markers(color = I("black"), alpha = 0.1) %>%
  # add annotations for the upper-right quadrant
  add_fun(
    function(plot) {
      plot %>% 
        filter(EFFECTSIZE > 1 & P2 > 2) %>% 
        add_markers(color = I("red")) %>%
        add_annotations(text = ~SNP)
    }
  ) %>%
  # add annotations for the upper-left quadrant
  add_fun(
    function(plot) {
      plot %>% 
        filter(EFFECTSIZE < -1 & P2 > 2) %>%
        add_markers(color = I("blue")) %>%
        add_annotations(text = ~SNP)
    }
  ) %>%
  toWebGL() %>% # webgl renders many points much more efficiently!
  layout(
    title = "My pretty graph",
    showlegend = FALSE,
    shapes = list(
      vline(-1),
      vline(1),
      hline(2)
    ),
    xaxis = list(
      title = "My x-axis title",
      zeroline = FALSE
    ),
    yaxis = list(
      title = "My y-axis title",
      zeroline = FALSE
    )
  ) %>%
  onRender("function(el, x) {
    el.on('plotly_click', function(d) {
      var pt = d.points[0];
      var url = pt.data.customdata[pt.pointNumber];
      window.open(url);
    });
  }") %>%
  saveWidget("index.html")



browseURL("index.html")