Skip to content

Commit

Permalink
Merge pull request #71 from andreyto/at_aspect
Browse files Browse the repository at this point in the history 
Option to maintain in the plot the aspect ratio of the input data
  • Loading branch information
@bwlewis
bwlewis committed Feb 23, 2018
2 parents 020ff84 + 115eaf6 commit 76a357b
Show file tree
Hide file tree
Showing 2 changed files with 81 additions and 36 deletions.
69 changes: 52 additions & 17 deletions R/scatterplot.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -14,9 +14,11 @@
#' @param height The container div height.
#' @param axis A logical value that when \code{TRUE} indicates that the
#' axes will be displayed.
#' @param num.ticks A three-element vector with the suggested number of
#' ticks to display per axis. Set to NULL to not display ticks. The number
#' of ticks may be adjusted by the program.
#' @param num.ticks A three-element or one-element vector with the suggested number of
#' ticks to display per axis. If a one-element vector, this number of ticks will be used
#' for the axis with the smallest \code{axis.scale}, and the number of ticks on the remaining
#' axes will be increased proportionally to the \code{axis.scale} values. Set to NULL to not display
#' ticks. The number of ticks may be adjusted by the program.
#' @param x.ticklabs A vector of tick labels of length \code{num.ticks[1]}, or
#' \code{NULL} to show numeric labels.
#' @param y.ticklabs A vector of tick labels of length \code{num.ticks[2]}, or
Expand Down Expand Up @@ -46,12 +48,21 @@
#' @param ylim Optional two-element vector of y-axis limits. Default auto-scales to data.
#' @param zlim Optional two-element vector of z-axis limits. Default auto-scales to data.
#' @param pch Optional point glyphs, see notes.
#' @param axis.scale Three-element vector to scale each axis as displayed on the plot,
#' after first scaling them all to a unit length. Default \code{c(1,1,1)} thus results
#' in the axes of equal length. If \code{NA}, the displayed axes will be scaled to the
#' ratios determined from \code{c(xlim,ylim,zlim)}.
#' @param ... Additional options (see note).
#'
#' @return
#' An htmlwidget object that is displayed using the object's show or print method.
#' (If you don't see your widget plot, try printing it with the \code{print} function.)
#'
#' @section Scaling the axes:
#' With the default values, the displayed axes are scaled to equal one-unit length. If
#' you instead need to maintain the relative distances between points in the original data,
#' and the same distance between the tick labels, pass \code{num.ticks=6} (or any other single
#' number) and \code{axis.scale=NA}
#' @section Interacting with the plot:
#' Press and hold the left mouse button (or touch or trackpad equivalent) and move
#' the mouse to rotate the plot. Press and hold the right mouse button (or touch
Expand Down Expand Up @@ -213,7 +224,9 @@ scatterplot3js <- function(
signif = 8,
bg = "#ffffff",
cex.symbols = 1,
xlim, ylim, zlim, pch="@", ...)
xlim, ylim, zlim,
axis.scale = c(1,1,1),
pch="@", ...)
{
# validate input
if (!missing(y) && !missing(z)) {
Expand Down Expand Up @@ -258,7 +271,7 @@ scatterplot3js <- function(

# javascript does not like dots in names
names(options) <- gsub("\\.", "", names(options))

if (!is.null(options$highlight)) options$highlight <- gcol(options$highlight)$color
if (!is.null(options$lowlight)) options$lowlight <- gcol(options$lowlight)$color

Expand All @@ -271,8 +284,7 @@ scatterplot3js <- function(
# Avoid asJson named vector warning
colnames(x[[1]]) <- NULL

# The Javascript code assumes a coordinate system in the unit box. Scale x
# to fit in there.
# Scale x to the output axis.scale ratio.
n <- NROW
mn <- Reduce(pmin, lapply(x, function(y) apply(y[, 1:3, drop=FALSE], 2, min)))
mx <- Reduce(pmax, lapply(x, function(y) apply(y[, 1:3, drop=FALSE], 2, max)))
Expand All @@ -288,20 +300,32 @@ scatterplot3js <- function(
mn[2] <- zlim[1]
mx[2] <- zlim[2]
}
x <- lapply(x, function(x) (x[, 1:3, drop=FALSE] - rep(mn, each = n)) / (rep(mx - mn, each = n)))
if(any(is.na(axis.scale))) {
axis.scale <- mx - mn
} else {
if(length(axis.scale)!=3) {
stop("axis.scale must be a vector of length three")
}
#reorder like the x
axis.scale <- axis.scale[c(1,3,2)]
}
#scale axis.scale so that the min value == 1; code below depends on it
axis.scale <- axis.scale / min(axis.scale)

x <- lapply(x, function(x) ((x[, 1:3, drop=FALSE] - rep(mn, each = n)) / rep((mx - mn)/axis.scale, each = n)))

if (flip.y)
{
x <- lapply(x, function(y)
{
y[, 3] <- 1 - y[, 3]
y[, 3] <- axis.scale[3] - y[, 3]
y
})
}

if ("center" %in% names(options) && options$center) # not yet documented, useful for graph
{
x <- lapply(x, function(y) 2 * (y - 0.5))
x <- lapply(x, function(y) 2 * (y - axis.scale/2))
# FIXME adjust scale/tick marks
}
if (!("linealpha" %in% names(options))) options$linealpha <- 1
Expand All @@ -314,15 +338,22 @@ scatterplot3js <- function(
# Ticks
if (!is.null(num.ticks))
{
if (length(num.ticks) != 3) stop("num.ticks must have length 3")
num.ticks <- pmax(1, num.ticks[c(1, 3, 2)])
if (length(num.ticks) != 3) {
if(length(num.ticks) != 1) {
stop("num.ticks must have length 3")
}
num.ticks <- round(max(1,num.ticks) * axis.scale)
}
else {
num.ticks <- pmax(1, num.ticks[c(1, 3, 2)])
}

t1 <- seq(from=mn[1], to=mx[1], length.out=num.ticks[1])
p1 <- (t1 - mn[1]) / (mx[1] - mn[1])
p1 <- (t1 - mn[1]) / (mx[1] - mn[1]) * axis.scale[1]
t2 <- seq(from=mn[2], to=mx[2], length.out=num.ticks[2])
p2 <- (t2 - mn[2]) / (mx[2] - mn[2])
p2 <- (t2 - mn[2]) / (mx[2] - mn[2]) * axis.scale[2]
t3 <- seq(from=mn[3], to=mx[3], length.out=num.ticks[3])
p3 <- (t3 - mn[3]) / (mx[3] - mn[3])
p3 <- (t3 - mn[3]) / (mx[3] - mn[3]) * axis.scale[3]
if (flip.y) t3 <- t3[length(t3):1]

pfmt <- function(x, d=2)
Expand All @@ -346,7 +377,10 @@ scatterplot3js <- function(
options$ytick <- p2
options$ztick <- p3
}


names(axis.scale) <- NULL
options$axislength <- axis.scale

# lines
if ("from" %in% names(options))
{
Expand Down Expand Up @@ -518,7 +552,8 @@ points3d <- function(s, x, y, z, color="orange", pch="@", size=1, labels="")
if (is.null(center)) center <- FALSE
args <- list(x=x, center=center, flip.y=options$flipy, options=TRUE, axis=options$axis,
color=color, num.ticks=options$numticks, x.ticklabs=options$xticklabs,
y.ticklabs=options$yticklabs, z.ticklabs=options$zticklabs)
y.ticklabs=options$yticklabs, z.ticklabs=options$zticklabs,
axis.scale=options$axisscale)
if (!is.null(options$xlim) || !is.symbol(options$xlim)) args$xlim <- options$xlim
if (!is.null(options$ylim) || !is.symbol(options$ylim)) args$ylim <- options$ylim
if (!is.null(options$zlim) || !is.symbol(options$zlim)) args$zlim <- options$zlim
Expand Down
48 changes: 29 additions & 19 deletions inst/htmlwidgets/scatterplotThree.js
View file
Original file line number Diff line number Diff line change
Expand Up @@ -73,6 +73,7 @@ HTMLWidgets.widget(
* zlim
* ztick
* zticklab
* axislength length of each axis (float[3])
* top optional infobox top position (int)
* left optional infobox left position (int)
* fontmain optional infobox css font
Expand Down Expand Up @@ -128,6 +129,7 @@ Widget.scatter = function(w, h)

if(height > 0) _this.camera = new THREE.PerspectiveCamera(40, width / height, 1e-5, 100);
else _this.camera = new THREE.PerspectiveCamera(40, 1, 1e-5, 100);

_this.camera.position.z = 2.0;
_this.camera.position.x = 2.5;
_this.camera.position.y = 1.2;
Expand Down Expand Up @@ -612,10 +614,10 @@ Widget.scatter = function(w, h)
// lights
/* FIXME add user-defined lights */
light = new THREE.DirectionalLight(0xffffff);
light.position.set(1, 1, 1);
light.position.set(x.axislength[0],x.axislength[1],x.axislength[3]);
scene.add(light);
light = new THREE.DirectionalLight(0x002255);
light.position.set(-1, -1, -1);
light.position.set(-x.axislength[0], -x.axislength[1], -x.axislength[2]);
scene.add(light);
light = new THREE.AmbientLight(0x444444);
scene.add(light );
Expand Down Expand Up @@ -858,9 +860,9 @@ Widget.scatter = function(w, h)
var xAxisGeo = new THREE.Geometry();
var yAxisGeo = new THREE.Geometry();
var zAxisGeo = new THREE.Geometry();
xAxisGeo.vertices.push(v(0, 0, 0), v(1, 0, 0));
yAxisGeo.vertices.push(v(0, 0, 0), v(0, 1, 0));
zAxisGeo.vertices.push(v(0, 0, 0), v(0, 0, 1));
xAxisGeo.vertices.push(v(0, 0, 0), v(x.axislength[0], 0, 0));
yAxisGeo.vertices.push(v(0, 0, 0), v(0, x.axislength[1], 0));
zAxisGeo.vertices.push(v(0, 0, 0), v(0, 0, x.axislength[2]));
var xAxis = new THREE.Line(xAxisGeo, new THREE.LineBasicMaterial({color: axisColor, linewidth: 1}));
var yAxis = new THREE.Line(yAxisGeo, new THREE.LineBasicMaterial({color: axisColor, linewidth: 1}));
var zAxis = new THREE.Line(zAxisGeo, new THREE.LineBasicMaterial({color: axisColor, linewidth: 1}));
Expand All @@ -872,9 +874,10 @@ Widget.scatter = function(w, h)
group.add(zAxis);
if(x.axisLabels)
{
addText(group, x.axisLabels[0], cexlab, 1.1, 0, 0, axisColor)
addText(group, x.axisLabels[1], cexlab, 0, 1.1, 0, axisColor)
addText(group, x.axisLabels[2], cexlab, 0, 0, 1.1, axisColor)
var dropOff = -0.08;
addText(group, x.axisLabels[0], cexlab, x.axislength[0] + .1, dropOff, dropOff, axisColor)
addText(group, x.axisLabels[1], cexlab, 0, x.axislength[1] + .1, 0, axisColor)
addText(group, x.axisLabels[2], cexlab, dropOff, dropOff, x.axislength[2] + .1, axisColor)
}
// Ticks and tick labels
function tick(length, thickness, axis, ticks, ticklabels)
Expand All @@ -901,23 +904,30 @@ Widget.scatter = function(w, h)
}

// Grid
if(x.grid && x.xtick && x.ztick && x.xtick.length == x.ztick.length)
{
for(var j=1; j < x.xtick.length; j++)
function grid(ticks,axis,axislength) {
for(var j=1; j < ticks.length; j++)
{
var gridline = new THREE.Geometry();
gridline.vertices.push(v(x.xtick[j], 0, 0), v(x.xtick[j], 0, 1));
if(axis==0) {
gridline.vertices.push(v(ticks[j], 0, 0), v(ticks[j], 0, axislength[2]));
}
else if(axis==2) {
gridline.vertices.push(v(0,0,ticks[j]), v(axislength[0],0,ticks[j]));
}
var gl = new THREE.Line(gridline, new THREE.LineBasicMaterial({color: tickColor, linewidth: 1}));
gl.type = THREE.Lines;
group.add(gl);
gridline = new THREE.Geometry();
gridline.vertices.push(v(0, 0, x.ztick[j]), v(1, 0, x.ztick[j]));
gl = new THREE.Line(gridline, new THREE.LineBasicMaterial({color: tickColor, linewidth: 1}));
gl.type=THREE.Lines;
group.add(gl);
}
}
}

if(x.grid && x.xtick)
{
grid(x.xtick,0,x.axislength);
}
if(x.grid && x.ztick)
{
grid(x.ztick,2,x.axislength);
}

// Lines
/* Note that variable line widths are not directly supported by buffered geometry, see for instance:
* http://stackoverflow.com/questions/32544413/buffergeometry-and-linebasicmaterial-segments-thickness
Expand Down

0 comments on commit 76a357b

Please sign in to comment.