Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

manyboxplots: box plots for many distributions, linked to histograms

  • Loading branch information...
commit a409d6d9e7954d44eabda7febb2b85e8882ed611 1 parent 763ace2
@kbroman authored
View
4 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>
View
2  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
View
2  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 $^
View
1  NAMESPACE
@@ -1,4 +1,5 @@
export(corr_w_scatter)
export(iplotPXG)
export(iplotScanone)
+export(manyboxplots)
export(qtlchartsversion)
View
62 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=","), "}")
+}
View
70 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)
+}
View
2  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) ->
View
406 inst/charts/manyboxplots.coffee
@@ -0,0 +1,406 @@
+# manyboxplots2.coffee
+#
+# Top panel is like a set of n box plots:
+# lines are drawn at the 0.1, 1, 10, 25, 50, 75, 90, 99, 99.9 percentiles
+# for each of n 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.
+#
+
+manyboxplots = (data) ->
+
+ # dimensions of SVG
+ w = 1000
+ h = 450
+ pad = {left:60, top:20, right:60, bottom: 40}
+
+ # axis labels
+ ylab = "Response"
+ xlab = "Individuals"
+
+ # y-axis limits for top figure
+ topylim = [data.quant[0][0], data.quant[0][1]]
+ for i of data.quant
+ for x in data.quant[i]
+ topylim[0] = x if x < topylim[0]
+ topylim[1] = x if x > topylim[1]
+ topylim[0] = Math.floor(topylim[0])
+ topylim[1] = Math.ceil(topylim[1])
+
+ # y-axis limits for bottom figure
+ botylim = [0, data.counts[0][1]]
+ for i of data.counts
+ for x in data.counts[i]
+ botylim[1] = x if x > botylim[1]
+
+ indindex = d3.range(data.ind.length)
+
+ # adjust counts object to make proper histogram
+ br2 = []
+ for i in data.breaks
+ br2.push(i)
+ br2.push(i)
+
+ fix4hist = (d) ->
+ x = [0]
+ for i in d
+ x.push(i)
+ x.push(i)
+ x.push(0)
+ x
+
+ for i of data.counts
+ data.counts[i] = fix4hist(data.counts[i])
+
+ # number of quantiles
+ nQuant = data.quant.length
+ midQuant = (nQuant+1)/2 - 1
+
+ # x and y scales for top figure
+ xScale = d3.scale.linear()
+ .domain([-1, data.ind.length])
+ .range([pad.left, w-pad.right])
+
+ # width of rectangles in top panel
+ recWidth = xScale(1) - xScale(0)
+
+ yScale = d3.scale.linear()
+ .domain(topylim)
+ .range([h-pad.bottom, pad.top])
+
+ # function to create quantile lines
+ quline = (j) ->
+ d3.svg.line()
+ .x((d) -> xScale(d))
+ .y((d) -> yScale(data.quant[j][d]))
+
+ svg = d3.select("div#chart")
+ .append("svg")
+ .attr("width", w)
+ .attr("height", h)
+
+ # gray background
+ svg.append("rect")
+ .attr("x", pad.left)
+ .attr("y", pad.top)
+ .attr("height", h-pad.top-pad.bottom)
+ .attr("width", w-pad.left-pad.right)
+ .attr("stroke", "none")
+ .attr("fill", d3.rgb(200, 200, 200))
+ .attr("pointer-events", "none")
+
+ # axis on left
+ LaxisData = yScale.ticks(6)
+ Laxis = svg.append("g").attr("id", "Laxis")
+
+ # axis: white lines
+ Laxis.append("g").selectAll("empty")
+ .data(LaxisData)
+ .enter()
+ .append("line")
+ .attr("class", "line")
+ .attr("class", "axis")
+ .attr("x1", pad.left)
+ .attr("x2", w-pad.right)
+ .attr("y1", (d) -> yScale(d))
+ .attr("y2", (d) -> yScale(d))
+ .attr("stroke", "white")
+ .attr("pointer-events", "none")
+
+ # function to determine rounding of axis labels
+ formatAxis = (d) ->
+ d = d[1] - d[0]
+ ndig = Math.floor( Math.log(d % 10) / Math.log(10) )
+ ndig = 0 if ndig > 0
+ ndig = Math.abs(ndig)
+ d3.format(".#{ndig}f")
+
+ # axis: labels
+ Laxis.append("g").selectAll("empty")
+ .data(LaxisData)
+ .enter()
+ .append("text")
+ .attr("class", "axis")
+ .text((d) -> formatAxis(LaxisData)(d))
+ .attr("x", pad.left*0.9)
+ .attr("y", (d) -> yScale(d))
+ .attr("dominant-baseline", "middle")
+ .attr("text-anchor", "end")
+
+ # axis on bottom
+ BaxisData = xScale.ticks(10)
+ Baxis = svg.append("g").attr("id", "Baxis")
+
+ # axis: white lines
+ Baxis.append("g").selectAll("empty")
+ .data(BaxisData)
+ .enter()
+ .append("line")
+ .attr("class", "line")
+ .attr("class", "axis")
+ .attr("y1", pad.top)
+ .attr("y2", h-pad.bottom)
+ .attr("x1", (d) -> xScale(d-1))
+ .attr("x2", (d) -> xScale(d-1))
+ .attr("stroke", "white")
+ .attr("pointer-events", "none")
+
+ # axis: labels
+ Baxis.append("g").selectAll("empty")
+ .data(BaxisData)
+ .enter()
+ .append("text")
+ .attr("class", "axis")
+ .text((d) -> d)
+ .attr("y", h-pad.bottom*0.75)
+ .attr("x", (d) -> xScale(d-1))
+ .attr("dominant-baseline", "middle")
+ .attr("text-anchor", "middle")
+
+ # colors for quantile curves
+ colindex = d3.range((nQuant-1)/2)
+ tmp = d3.scale.category10().domain(colindex)
+ qucolors = []
+ for j in colindex
+ qucolors.push(tmp(j))
+ qucolors.push("black")
+ for j in colindex.reverse()
+ qucolors.push(tmp(j))
+
+ # curves for quantiles
+ curves = svg.append("g").attr("id", "curves")
+
+ for j in [0...nQuant]
+ curves.append("path")
+ .datum(indindex)
+ .attr("d", quline(j))
+ .attr("class", "line")
+ .attr("stroke", qucolors[j])
+ .attr("pointer-events", "none")
+
+ # vertical rectangles representing each array
+ indRectGrp = svg.append("g").attr("id", "indRect")
+
+ indRect = indRectGrp.selectAll("empty")
+ .data(indindex)
+ .enter()
+ .append("rect")
+ .attr("x", (d) -> xScale(d) - recWidth/2)
+ .attr("y", (d) -> yScale(data.quant[nQuant-1][d]))
+ .attr("id", (d) -> "rect#{data.ind[d]}")
+ .attr("width", recWidth)
+ .attr("height", (d) ->
+ yScale(data.quant[0][d]) - yScale(data.quant[nQuant-1][d]))
+ .attr("fill", "purple")
+ .attr("stroke", "none")
+ .attr("opacity", "0")
+ .attr("pointer-events", "none")
+
+ # vertical rectangles representing each array
+ longRectGrp = svg.append("g").attr("id", "longRect")
+
+ longRect = indRectGrp.selectAll("empty")
+ .data(indindex)
+ .enter()
+ .append("rect")
+ .attr("x", (d) -> xScale(d) - recWidth/2)
+ .attr("y", pad.top)
+ .attr("width", recWidth)
+ .attr("height", h - pad.top - pad.bottom)
+ .attr("fill", "purple")
+ .attr("stroke", "none")
+ .attr("opacity", "0")
+
+ # label quantiles on right
+ rightAxis = svg.append("g").attr("id", "rightAxis")
+
+ rightAxis.selectAll("empty")
+ .data(data.qu)
+ .enter()
+ .append("text")
+ .attr("class", "qu")
+ .text( (d) -> "#{d*100}%")
+ .attr("x", w)
+ .attr("y", (d,i) -> yScale(((i+0.5)/nQuant/2 + 0.25) * (topylim[1] - topylim[0]) + topylim[0]))
+ .attr("fill", (d,i) -> qucolors[i])
+ .attr("text-anchor", "end")
+ .attr("dominant-baseline", "middle")
+
+ # box around the outside
+ svg.append("rect")
+ .attr("x", pad.left)
+ .attr("y", pad.top)
+ .attr("height", h-pad.top-pad.bottom)
+ .attr("width", w-pad.left-pad.right)
+ .attr("stroke", "black")
+ .attr("stroke-width", 2)
+ .attr("fill", "none")
+
+ # lower svg
+ lowsvg = d3.select("div#chart").append("svg")
+ .attr("height", h)
+ .attr("width", w)
+
+ lo = data.breaks[0] - (data.breaks[1] - data.breaks[0])
+ hi = data.breaks[data.breaks.length-1] + (data.breaks[1] - data.breaks[0])
+
+ lowxScale = d3.scale.linear()
+ .domain([lo, hi])
+ .range([pad.left, w-pad.right])
+
+ lowyScale = d3.scale.linear()
+ .domain([0, botylim[1]+1])
+ .range([h-pad.bottom, pad.top])
+
+ # gray background
+ lowsvg.append("rect")
+ .attr("x", pad.left)
+ .attr("y", pad.top)
+ .attr("height", h-pad.top-pad.bottom)
+ .attr("width", w-pad.left-pad.right)
+ .attr("stroke", "none")
+ .attr("fill", d3.rgb(200, 200, 200))
+
+ # axis on left
+ lowBaxisData = lowxScale.ticks(8)
+ lowBaxis = lowsvg.append("g").attr("id", "lowBaxis")
+
+ # axis: white lines
+ lowBaxis.append("g").selectAll("empty")
+ .data(lowBaxisData)
+ .enter()
+ .append("line")
+ .attr("class", "line")
+ .attr("class", "axis")
+ .attr("y1", pad.top)
+ .attr("y2", h-pad.bottom)
+ .attr("x1", (d) -> lowxScale(d))
+ .attr("x2", (d) -> lowxScale(d))
+ .attr("stroke", "white")
+
+ # axis: labels
+ lowBaxis.append("g").selectAll("empty")
+ .data(lowBaxisData)
+ .enter()
+ .append("text")
+ .attr("class", "axis")
+ .text((d) -> formatAxis(lowBaxisData)(d))
+ .attr("y", h-pad.bottom*0.75)
+ .attr("x", (d) -> lowxScale(d))
+ .attr("dominant-baseline", "middle")
+ .attr("text-anchor", "middle")
+
+ grp4BkgdHist = lowsvg.append("g").attr("id", "bkgdHist")
+
+ histline = d3.svg.line()
+ .x((d,i) -> lowxScale(br2[i]))
+ .y((d) -> lowyScale(d))
+
+ randomInd = indindex[Math.floor(Math.random()*data.ind.length)]
+
+ hist = lowsvg.append("path")
+ .datum(data.counts[randomInd])
+ .attr("d", histline)
+ .attr("id", "histline")
+ .attr("fill", "none")
+ .attr("stroke", "purple")
+ .attr("stroke-width", "2")
+
+
+ histColors = ["blue", "red", "green", "MediumVioletRed", "black"]
+
+ lowsvg.append("text")
+ .datum(randomInd)
+ .attr("x", pad.left*1.1)
+ .attr("y", pad.top*2)
+ .text((d) -> data.ind[d])
+ .attr("id", "histtitle")
+ .attr("text-anchor", "start")
+ .attr("dominant-baseline", "middle")
+ .attr("fill", "blue")
+
+ clickStatus = []
+ for d in indindex
+ clickStatus.push(0)
+
+ longRect
+ .on "mouseover", (d) ->
+ d3.select("rect#rect#{data.ind[d]}")
+ .attr("opacity", "1")
+ d3.select("#histline")
+ .datum(data.counts[d])
+ .attr("d", histline)
+ d3.select("#histtitle")
+ .datum(d)
+ .text((d) -> data.ind[d])
+
+ .on "mouseout", (d) ->
+ if !clickStatus[d]
+ d3.select("rect#rect#{data.ind[d]}").attr("opacity", "0")
+
+ .on "click", (d) ->
+ console.log("Click: #{data.ind[d]} (#{d+1})")
+ clickStatus[d] = 1 - clickStatus[d]
+ d3.select("rect#rect#{data.ind[d]}").attr("opacity", clickStatus[d])
+ if clickStatus[d]
+ curcolor = histColors.shift()
+ histColors.push(curcolor)
+
+ d3.select("rect#rect#{data.ind[d]}").attr("fill", curcolor)
+
+ grp4BkgdHist.append("path")
+ .datum(data.counts[d])
+ .attr("d", histline)
+ .attr("id", "path#{data.ind[d]}")
+ .attr("fill", "none")
+ .attr("stroke", curcolor)
+ .attr("stroke-width", "2")
+ else
+ d3.select("path#path#{data.ind[d]}").remove()
+
+ # box around the outside
+ lowsvg.append("rect")
+ .attr("x", pad.left)
+ .attr("y", pad.top)
+ .attr("height", h-pad.bottom-pad.top)
+ .attr("width", w-pad.left-pad.right)
+ .attr("stroke", "black")
+ .attr("stroke-width", 2)
+ .attr("fill", "none")
+
+ svg.append("text")
+ .text(ylab)
+ .attr("x", pad.left*0.2)
+ .attr("y", h/2)
+ .attr("fill", "blue")
+ .attr("transform", "rotate(270 #{pad.left*0.2} #{h/2})")
+ .attr("dominant-baseline", "middle")
+ .attr("text-anchor", "middle")
+
+ lowsvg.append("text")
+ .text(ylab)
+ .attr("x", (w-pad.left-pad.bottom)/2+pad.left)
+ .attr("y", h-pad.bottom*0.2)
+ .attr("fill", "blue")
+ .attr("dominant-baseline", "middle")
+ .attr("text-anchor", "middle")
+
+ svg.append("text")
+ .text(xlab)
+ .attr("x", (w-pad.left-pad.bottom)/2+pad.left)
+ .attr("y", h-pad.bottom*0.2)
+ .attr("fill", "blue")
+ .attr("dominant-baseline", "middle")
+ .attr("text-anchor", "middle")
+
+ # add legend
+ text = "The top panel is like #{data.ind.length} boxplots:\n"
+ text += "lines are drawn at the "
+ for q,i in data.qu
+ if i > 0
+ text += ", "
+ text += "#{q*100}"
+ text += " percentiles for each of #{data.ind.length} distributions.\n"
+
+ d3.select("div#legend")
+ .style("opacity", 1)
View
226 inst/charts/manyboxplots.js
@@ -0,0 +1,226 @@
+// Generated by CoffeeScript 1.6.3
+var manyboxplots;
+
+manyboxplots = function(data) {
+ var Baxis, BaxisData, Laxis, LaxisData, botylim, br2, clickStatus, colindex, curves, d, fix4hist, formatAxis, grp4BkgdHist, h, hi, hist, histColors, histline, i, indRect, indRectGrp, indindex, j, lo, longRect, longRectGrp, lowBaxis, lowBaxisData, lowsvg, lowxScale, lowyScale, midQuant, nQuant, pad, q, qucolors, quline, randomInd, recWidth, rightAxis, svg, text, tmp, topylim, w, x, xScale, xlab, yScale, ylab, _i, _j, _k, _l, _len, _len1, _len2, _len3, _len4, _len5, _len6, _m, _n, _o, _p, _ref, _ref1, _ref2, _ref3, _ref4;
+ w = 1000;
+ h = 450;
+ pad = {
+ left: 60,
+ top: 20,
+ right: 60,
+ bottom: 40
+ };
+ ylab = "Response";
+ xlab = "Individuals";
+ topylim = [data.quant[0][0], data.quant[0][1]];
+ for (i in data.quant) {
+ _ref = data.quant[i];
+ for (_i = 0, _len = _ref.length; _i < _len; _i++) {
+ x = _ref[_i];
+ if (x < topylim[0]) {
+ topylim[0] = x;
+ }
+ if (x > topylim[1]) {
+ topylim[1] = x;
+ }
+ }
+ }
+ topylim[0] = Math.floor(topylim[0]);
+ topylim[1] = Math.ceil(topylim[1]);
+ botylim = [0, data.counts[0][1]];
+ for (i in data.counts) {
+ _ref1 = data.counts[i];
+ for (_j = 0, _len1 = _ref1.length; _j < _len1; _j++) {
+ x = _ref1[_j];
+ if (x > botylim[1]) {
+ botylim[1] = x;
+ }
+ }
+ }
+ indindex = d3.range(data.ind.length);
+ br2 = [];
+ _ref2 = data.breaks;
+ for (_k = 0, _len2 = _ref2.length; _k < _len2; _k++) {
+ i = _ref2[_k];
+ br2.push(i);
+ br2.push(i);
+ }
+ fix4hist = function(d) {
+ var _l, _len3;
+ x = [0];
+ for (_l = 0, _len3 = d.length; _l < _len3; _l++) {
+ i = d[_l];
+ x.push(i);
+ x.push(i);
+ }
+ x.push(0);
+ return x;
+ };
+ for (i in data.counts) {
+ data.counts[i] = fix4hist(data.counts[i]);
+ }
+ nQuant = data.quant.length;
+ midQuant = (nQuant + 1) / 2 - 1;
+ xScale = d3.scale.linear().domain([-1, data.ind.length]).range([pad.left, w - pad.right]);
+ recWidth = xScale(1) - xScale(0);
+ yScale = d3.scale.linear().domain(topylim).range([h - pad.bottom, pad.top]);
+ quline = function(j) {
+ return d3.svg.line().x(function(d) {
+ return xScale(d);
+ }).y(function(d) {
+ return yScale(data.quant[j][d]);
+ });
+ };
+ svg = d3.select("div#chart").append("svg").attr("width", w).attr("height", h);
+ svg.append("rect").attr("x", pad.left).attr("y", pad.top).attr("height", h - pad.top - pad.bottom).attr("width", w - pad.left - pad.right).attr("stroke", "none").attr("fill", d3.rgb(200, 200, 200)).attr("pointer-events", "none");
+ LaxisData = yScale.ticks(6);
+ Laxis = svg.append("g").attr("id", "Laxis");
+ Laxis.append("g").selectAll("empty").data(LaxisData).enter().append("line").attr("class", "line").attr("class", "axis").attr("x1", pad.left).attr("x2", w - pad.right).attr("y1", function(d) {
+ return yScale(d);
+ }).attr("y2", function(d) {
+ return yScale(d);
+ }).attr("stroke", "white").attr("pointer-events", "none");
+ formatAxis = function(d) {
+ var ndig;
+ d = d[1] - d[0];
+ ndig = Math.floor(Math.log(d % 10) / Math.log(10));
+ if (ndig > 0) {
+ ndig = 0;
+ }
+ ndig = Math.abs(ndig);
+ return d3.format("." + ndig + "f");
+ };
+ Laxis.append("g").selectAll("empty").data(LaxisData).enter().append("text").attr("class", "axis").text(function(d) {
+ return formatAxis(LaxisData)(d);
+ }).attr("x", pad.left * 0.9).attr("y", function(d) {
+ return yScale(d);
+ }).attr("dominant-baseline", "middle").attr("text-anchor", "end");
+ BaxisData = xScale.ticks(10);
+ Baxis = svg.append("g").attr("id", "Baxis");
+ Baxis.append("g").selectAll("empty").data(BaxisData).enter().append("line").attr("class", "line").attr("class", "axis").attr("y1", pad.top).attr("y2", h - pad.bottom).attr("x1", function(d) {
+ return xScale(d - 1);
+ }).attr("x2", function(d) {
+ return xScale(d - 1);
+ }).attr("stroke", "white").attr("pointer-events", "none");
+ Baxis.append("g").selectAll("empty").data(BaxisData).enter().append("text").attr("class", "axis").text(function(d) {
+ return d;
+ }).attr("y", h - pad.bottom * 0.75).attr("x", function(d) {
+ return xScale(d - 1);
+ }).attr("dominant-baseline", "middle").attr("text-anchor", "middle");
+ colindex = d3.range((nQuant - 1) / 2);
+ tmp = d3.scale.category10().domain(colindex);
+ qucolors = [];
+ for (_l = 0, _len3 = colindex.length; _l < _len3; _l++) {
+ j = colindex[_l];
+ qucolors.push(tmp(j));
+ }
+ qucolors.push("black");
+ _ref3 = colindex.reverse();
+ for (_m = 0, _len4 = _ref3.length; _m < _len4; _m++) {
+ j = _ref3[_m];
+ qucolors.push(tmp(j));
+ }
+ curves = svg.append("g").attr("id", "curves");
+ for (j = _n = 0; 0 <= nQuant ? _n < nQuant : _n > nQuant; j = 0 <= nQuant ? ++_n : --_n) {
+ curves.append("path").datum(indindex).attr("d", quline(j)).attr("class", "line").attr("stroke", qucolors[j]).attr("pointer-events", "none");
+ }
+ indRectGrp = svg.append("g").attr("id", "indRect");
+ indRect = indRectGrp.selectAll("empty").data(indindex).enter().append("rect").attr("x", function(d) {
+ return xScale(d) - recWidth / 2;
+ }).attr("y", function(d) {
+ return yScale(data.quant[nQuant - 1][d]);
+ }).attr("id", function(d) {
+ return "rect" + data.ind[d];
+ }).attr("width", recWidth).attr("height", function(d) {
+ return yScale(data.quant[0][d]) - yScale(data.quant[nQuant - 1][d]);
+ }).attr("fill", "purple").attr("stroke", "none").attr("opacity", "0").attr("pointer-events", "none");
+ longRectGrp = svg.append("g").attr("id", "longRect");
+ longRect = indRectGrp.selectAll("empty").data(indindex).enter().append("rect").attr("x", function(d) {
+ return xScale(d) - recWidth / 2;
+ }).attr("y", pad.top).attr("width", recWidth).attr("height", h - pad.top - pad.bottom).attr("fill", "purple").attr("stroke", "none").attr("opacity", "0");
+ rightAxis = svg.append("g").attr("id", "rightAxis");
+ rightAxis.selectAll("empty").data(data.qu).enter().append("text").attr("class", "qu").text(function(d) {
+ return "" + (d * 100) + "%";
+ }).attr("x", w).attr("y", function(d, i) {
+ return yScale(((i + 0.5) / nQuant / 2 + 0.25) * (topylim[1] - topylim[0]) + topylim[0]);
+ }).attr("fill", function(d, i) {
+ return qucolors[i];
+ }).attr("text-anchor", "end").attr("dominant-baseline", "middle");
+ svg.append("rect").attr("x", pad.left).attr("y", pad.top).attr("height", h - pad.top - pad.bottom).attr("width", w - pad.left - pad.right).attr("stroke", "black").attr("stroke-width", 2).attr("fill", "none");
+ lowsvg = d3.select("div#chart").append("svg").attr("height", h).attr("width", w);
+ lo = data.breaks[0] - (data.breaks[1] - data.breaks[0]);
+ hi = data.breaks[data.breaks.length - 1] + (data.breaks[1] - data.breaks[0]);
+ lowxScale = d3.scale.linear().domain([lo, hi]).range([pad.left, w - pad.right]);
+ lowyScale = d3.scale.linear().domain([0, botylim[1] + 1]).range([h - pad.bottom, pad.top]);
+ lowsvg.append("rect").attr("x", pad.left).attr("y", pad.top).attr("height", h - pad.top - pad.bottom).attr("width", w - pad.left - pad.right).attr("stroke", "none").attr("fill", d3.rgb(200, 200, 200));
+ lowBaxisData = lowxScale.ticks(8);
+ lowBaxis = lowsvg.append("g").attr("id", "lowBaxis");
+ lowBaxis.append("g").selectAll("empty").data(lowBaxisData).enter().append("line").attr("class", "line").attr("class", "axis").attr("y1", pad.top).attr("y2", h - pad.bottom).attr("x1", function(d) {
+ return lowxScale(d);
+ }).attr("x2", function(d) {
+ return lowxScale(d);
+ }).attr("stroke", "white");
+ lowBaxis.append("g").selectAll("empty").data(lowBaxisData).enter().append("text").attr("class", "axis").text(function(d) {
+ return formatAxis(lowBaxisData)(d);
+ }).attr("y", h - pad.bottom * 0.75).attr("x", function(d) {
+ return lowxScale(d);
+ }).attr("dominant-baseline", "middle").attr("text-anchor", "middle");
+ grp4BkgdHist = lowsvg.append("g").attr("id", "bkgdHist");
+ histline = d3.svg.line().x(function(d, i) {
+ return lowxScale(br2[i]);
+ }).y(function(d) {
+ return lowyScale(d);
+ });
+ randomInd = indindex[Math.floor(Math.random() * data.ind.length)];
+ hist = lowsvg.append("path").datum(data.counts[randomInd]).attr("d", histline).attr("id", "histline").attr("fill", "none").attr("stroke", "purple").attr("stroke-width", "2");
+ histColors = ["blue", "red", "green", "MediumVioletRed", "black"];
+ lowsvg.append("text").datum(randomInd).attr("x", pad.left * 1.1).attr("y", pad.top * 2).text(function(d) {
+ return data.ind[d];
+ }).attr("id", "histtitle").attr("text-anchor", "start").attr("dominant-baseline", "middle").attr("fill", "blue");
+ clickStatus = [];
+ for (_o = 0, _len5 = indindex.length; _o < _len5; _o++) {
+ d = indindex[_o];
+ clickStatus.push(0);
+ }
+ longRect.on("mouseover", function(d) {
+ d3.select("rect#rect" + data.ind[d]).attr("opacity", "1");
+ d3.select("#histline").datum(data.counts[d]).attr("d", histline);
+ return d3.select("#histtitle").datum(d).text(function(d) {
+ return data.ind[d];
+ });
+ }).on("mouseout", function(d) {
+ if (!clickStatus[d]) {
+ return d3.select("rect#rect" + data.ind[d]).attr("opacity", "0");
+ }
+ }).on("click", function(d) {
+ var curcolor;
+ console.log("Click: " + data.ind[d] + " (" + (d + 1) + ")");
+ clickStatus[d] = 1 - clickStatus[d];
+ d3.select("rect#rect" + data.ind[d]).attr("opacity", clickStatus[d]);
+ if (clickStatus[d]) {
+ curcolor = histColors.shift();
+ histColors.push(curcolor);
+ d3.select("rect#rect" + data.ind[d]).attr("fill", curcolor);
+ return grp4BkgdHist.append("path").datum(data.counts[d]).attr("d", histline).attr("id", "path" + data.ind[d]).attr("fill", "none").attr("stroke", curcolor).attr("stroke-width", "2");
+ } else {
+ return d3.select("path#path" + data.ind[d]).remove();
+ }
+ });
+ lowsvg.append("rect").attr("x", pad.left).attr("y", pad.top).attr("height", h - pad.bottom - pad.top).attr("width", w - pad.left - pad.right).attr("stroke", "black").attr("stroke-width", 2).attr("fill", "none");
+ svg.append("text").text(ylab).attr("x", pad.left * 0.2).attr("y", h / 2).attr("fill", "blue").attr("transform", "rotate(270 " + (pad.left * 0.2) + " " + (h / 2) + ")").attr("dominant-baseline", "middle").attr("text-anchor", "middle");
+ lowsvg.append("text").text(ylab).attr("x", (w - pad.left - pad.bottom) / 2 + pad.left).attr("y", h - pad.bottom * 0.2).attr("fill", "blue").attr("dominant-baseline", "middle").attr("text-anchor", "middle");
+ svg.append("text").text(xlab).attr("x", (w - pad.left - pad.bottom) / 2 + pad.left).attr("y", h - pad.bottom * 0.2).attr("fill", "blue").attr("dominant-baseline", "middle").attr("text-anchor", "middle");
+ text = "The top panel is like " + data.ind.length + " boxplots:\n";
+ text += "lines are drawn at the ";
+ _ref4 = data.qu;
+ for (i = _p = 0, _len6 = _ref4.length; _p < _len6; i = ++_p) {
+ q = _ref4[i];
+ if (i > 0) {
+ text += ", ";
+ }
+ text += "" + (q * 100);
+ }
+ text += " percentiles for each of " + data.ind.length + " distributions.\n";
+ return d3.select("div#legend").style("opacity", 1);
+};
View
50 man/manyboxplots.Rd
@@ -0,0 +1,50 @@
+\name{manyboxplots}
+\alias{manyboxplots}
+\title{Modern boxplot linked to underlying histrograms}
+\usage{
+manyboxplots(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)
+}
+\arguments{
+ \item{dat}{Data matrix (individuals x variables)}
+
+ \item{qu}{Quantiles to plot (All with 0 < qu < 0.5)}
+
+ \item{orderByMedian}{If TRUE, reorder individuals by
+ their median}
+
+ \item{breaks}{Number of break points in the histogram}
+
+ \item{file}{Optional character vector with file to
+ contain the output}
+
+ \item{onefile}{If TRUE, have output file contain all
+ necessary javascript/css code}
+
+ \item{openfile}{If TRUE, open the plot in the default web
+ browser}
+
+ \item{title}{Character string with title for plot}
+
+ \item{legend}{Character vector with text for a legend (to
+ be combined to one string with \code{\link[base]{paste}},
+ with \code{collapse=''})}
+}
+\value{
+Character string with the name of the file created.
+}
+\description{
+Creates an interactive graph for a large set of box plots
+(rendered as lines connecting the quantiles), linked to
+underlying histograms.
+}
+\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)
+}
+
Please sign in to comment.
Something went wrong with that request. Please try again.