manyboxplots: box plots for many distributions, linked to histograms

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: qtlcharts
-Version: 0.1-7
-Date: 14 Dec 2013
+Version: 0.1-8
+Date: 18 Feb 2014
 Title: Interactive graphics for QTL experiments
 Author: Karl W Broman <kbroman@biostat.wisc.edu>
 Maintainer: Karl W Broman <kbroman@biostat.wisc.edu>

LICENSE

@@ -1,6 +1,6 @@
 The MIT License (MIT)
 
-Copyright (c) 2013 Karl W Broman
+Copyright (c) 2013-2014 Karl W Broman
 
 Permission is hereby granted, free of charge, to any person obtaining
 a copy of this software and associated documentation files (the

Makefile

@@ -63,7 +63,7 @@ ${PANEL_DIR}/*/test/d3-tip.css: inst/d3-tip/d3-tip.css
 #------------------------------------------------------------
 
 # javascript for the real charts
-jscharts: ${CHART_DIR}/iplotScanone_noeff.js ${CHART_DIR}/iplotScanone_pxg.js ${CHART_DIR}/iplotPXG.js ${CHART_DIR}/corr_w_scatter.js
+jscharts: ${CHART_DIR}/iplotScanone_noeff.js ${CHART_DIR}/iplotScanone_pxg.js ${CHART_DIR}/iplotPXG.js ${CHART_DIR}/corr_w_scatter.js ${CHART_DIR}/manyboxplots.js
 
 ${CHART_DIR}/%.js: ${CHART_DIR}/%.coffee
 	coffee ${COFFEE_ARGS} -b $^

NAMESPACE

@@ -1,4 +1,5 @@
 export(corr_w_scatter)
 export(iplotPXG)
 export(iplotScanone)
+export(manyboxplots)
 export(qtlchartsversion)

R/convert4manyboxplots.R

@@ -0,0 +1,62 @@
+# convert4manyboxplots
+# Karl W Broman
+
+# Convert data to JSON format for manyboxplots vis
+#
+# @param dat Data matrix (individuals x variables)
+# @param qu Quantiles to plot (All with 0 < qu < 0.5)
+# @param orderByMedian If TRUE, reorder individuals by their median
+# @param breaks Number of break points in the histogram
+# @seealso \code{\link{manyboxplots}}
+# @keywords interface
+# @examples
+# \dontrun{
+# n.ind <- 500
+# n.gene <- 10000
+# expr <- matrix(rnorm(n.ind * n.gene, (1:n.ind)/n.ind*3), ncol=n.gene)
+# dimnames(expr) <- list(paste0("ind", 1:n.ind),
+#                        paste0("gene", 1:n.gene))
+# geneExpr_as_json <- convert4manyboxplots(expr)
+# }
+convert4manyboxplots <-
+function(dat, qu = c(0.001, 0.01, 0.1, 0.25), orderByMedian=TRUE,
+         breaks=251)
+{
+  if(is.null(rownames(dat)))
+    rownames(dat) <- paste0(1:nrow(dat))
+
+  if(orderByMedian)
+    dat <- dat[order(apply(dat, 1, median, na.rm=TRUE)),,drop=FALSE]
+
+  # check quantiles
+  if(any(qu <= 0)) {
+    warning("qu should all be > 0")
+    qu <- qu[qu > 0]
+  }
+
+  if(any(qu >= 0.5)) {
+    warning("qu should all by < 0.5")
+    qu <- qu[qu < 0.5]
+  }
+
+  qu <- c(qu, 0.5, rev(1-qu))
+  quant <- apply(dat, 1, quantile, qu, na.rm=TRUE)
+
+  # counts for histograms
+  if(length(breaks) == 1)
+    breaks <- seq(min(dat, na.rm=TRUE), max(dat, na.rm=TRUE), length=breaks)
+
+  counts <- apply(dat, 1, function(a) hist(a, breaks=breaks, plot=FALSE)$counts)
+
+  ind <- rownames(dat)
+
+  dimnames(quant) <- dimnames(counts) <- NULL
+
+  # data structure for JSON
+  output <- list("ind" = toJSON(ind),
+                 "qu" = toJSON(qu),
+                 "breaks" = toJSON(breaks),
+                 "quant" = toJSON(quant),
+                 "counts" = toJSON(t(counts)))
+  paste0("{", paste0("\"", names(output), "\" :", output, collapse=","), "}")
+}

R/manyboxplots.R

@@ -0,0 +1,70 @@
+# manyboxplots
+# Karl W Broman
+
+#' Modern boxplot linked to underlying histrograms
+#'
+#' Creates an interactive graph for a large set of box plots (rendered
+#' as lines connecting the quantiles), linked to underlying histograms.
+#'
+#' @param dat Data matrix (individuals x variables)
+#' @param qu Quantiles to plot (All with 0 < qu < 0.5)
+#' @param orderByMedian If TRUE, reorder individuals by their median
+#' @param breaks Number of break points in the histogram
+#' @param file Optional character vector with file to contain the output
+#' @param onefile If TRUE, have output file contain all necessary javascript/css code
+#' @param openfile If TRUE, open the plot in the default web browser
+#' @param title Character string with title for plot
+#' @param legend Character vector with text for a legend (to be
+#' combined to one string with \code{\link[base]{paste}}, with
+#' \code{collapse=''})
+#'
+#' @return Character string with the name of the file created.
+#' @export
+#'
+#' @examples
+#' n.ind <- 500
+#' n.gene <- 10000
+#' expr <- matrix(rnorm(n.ind * n.gene, (1:n.ind)/n.ind*3), ncol=n.gene)
+#' dimnames(expr) <- list(paste0("ind", 1:n.ind),
+#'                        paste0("gene", 1:n.gene))
+#' manyboxplots(expr)
+manyboxplots <-
+function(dat, qu = c(0.001, 0.01, 0.1, 0.25), orderByMedian=TRUE, breaks=251,
+         file, onefile=FALSE, openfile=TRUE, title="Many box plots",
+         legend)
+{
+  if(missing(file))
+    file <- tempfile(tmpdir=tempdir(), fileext='.html')
+  else file <- path.expand(file)
+
+  if(file.exists(file))
+    stop('The file already exists; please remove it first: ', file)
+
+  json <- convert4manyboxplots(dat, qu, orderByMedian, breaks)
+
+  # start writing
+  write_html_top(file, title=title)
+
+  link_d3(file, onefile=onefile)
+  link_d3tip(file, onefile=onefile)
+  link_chart('manyboxplots', file, onefile=onefile)
+
+  append_html_middle(file, title, 'chart')
+
+  if(missing(legend))
+    legend <- c('Top panel is like a set of ', nrow(dat), ' box plots: ',
+                'lines are drawn at a series of percentiles for each of the distributions. ',
+                'Hover over a column in the top panel and the corresponding distribution ',
+                'is show below; click for it to persist; click again to make it go away.')
+
+  append_legend(legend, file)
+
+  append_html_jscode(file, 'data = ', json, ';')
+  append_html_jscode(file, 'manyboxplots(data);')
+
+  append_html_bottom(file)
+
+  if(openfile) browseURL(file)
+
+  invisible(file)
+}

inst/charts/corr_w_scatter.coffee

@@ -2,8 +2,6 @@
 #
 # Left panel is a heat map of a correlation matrix; hover over pixels
 # to see the values; click to see the corresponding scatterplot on the right
-#
-# This code is very rough.
 
 corr_w_scatter = (data) ->