diff --git a/DESCRIPTION b/DESCRIPTION index 74766304..4f51c2c5 100644 --- a/DESCRIPTION +++ b/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 Maintainer: Karl W Broman diff --git a/LICENSE b/LICENSE index e715102c..ce812cbe 100644 --- a/LICENSE +++ b/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 diff --git a/Makefile b/Makefile index e743ce3c..68c1db69 100644 --- a/Makefile +++ b/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 $^ diff --git a/NAMESPACE b/NAMESPACE index fd474719..04f384f2 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,4 +1,5 @@ export(corr_w_scatter) export(iplotPXG) export(iplotScanone) +export(manyboxplots) export(qtlchartsversion) diff --git a/R/convert4manyboxplots.R b/R/convert4manyboxplots.R new file mode 100644 index 00000000..0ab90a58 --- /dev/null +++ b/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=","), "}") +} diff --git a/R/manyboxplots.R b/R/manyboxplots.R new file mode 100644 index 00000000..955b8abb --- /dev/null +++ b/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) +} diff --git a/inst/charts/corr_w_scatter.coffee b/inst/charts/corr_w_scatter.coffee index 83efbc8f..d556ffeb 100644 --- a/inst/charts/corr_w_scatter.coffee +++ b/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) -> diff --git a/inst/charts/manyboxplots.coffee b/inst/charts/manyboxplots.coffee new file mode 100644 index 00000000..5976cf06 --- /dev/null +++ b/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) diff --git a/inst/charts/manyboxplots.js b/inst/charts/manyboxplots.js new file mode 100644 index 00000000..5de90cd7 --- /dev/null +++ b/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); +}; diff --git a/man/manyboxplots.Rd b/man/manyboxplots.Rd new file mode 100644 index 00000000..f16f3a47 --- /dev/null +++ b/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) +} +