axis labels option and extreme points option

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: tourr
 Title: Tour Methods for Multivariate Data Visualisation
-Version: 1.2.0
+Version: 1.2.1
 Authors@R: c(
  person("Hadley", "Wickham", email = "h.wickham@gmail.com", role = c("aut", "ctb"), comment = c(ORCID = "0000-0003-4757-117X")),
  person("Dianne", "Cook", email = "dicook@monash.edu", role = c("aut", "cre"), comment = c(ORCID = "0000-0002-3813-7155")),

NEWS.md

@@ -1,3 +1,8 @@
+# tourr 1.2.1
+
+* anomaly tour is initialised with a random basis
+* option to label only long axes
+
 # tourr 1.2.0 
 
 * major change: rescale is now FALSE by default.

R/display-density2d.r

@@ -14,6 +14,7 @@
 #' @param cex size of the point to be plotted. Defaults to 1.
 #' @param contour_quartile Vector of quartiles to plot the contours at. Defaults to 5.
 #' @param palette name of color palette for point colour, used by \code{\link{hcl.colors}}, default "Zissou 1"
+#' @param axislablong text labels only for the long axes in a projection, default FALSE
 #' @param ... other arguments passed on to \code{\link{animate}} and
 #' \code{\link{display_density2d}}
 #' @importFrom graphics contour
@@ -53,7 +54,8 @@
 display_density2d <- function(center = TRUE, axes = "center", half_range = NULL,
  col = "black", pch = 20, cex = 1,
  contour_quartile = c(.25, .5, .75), edges = NULL,
- palette = "Zissou 1", ...) {
+ palette = "Zissou 1",
+ axislablong = FALSE, ...) {
  # If colors are a variable, convert to colors
  if (is.factor(col) | !areColors(col)) {
  gps <- col
@@ -80,7 +82,7 @@ display_density2d <- function(center = TRUE, axes = "center", half_range = NULL,
  rect(-1, -1, 1, 1, col = "#FFFFFFE6", border = NA)
  }
  render_data <- function(data, proj, geodesic) {
- draw_tour_axes(proj, labels, limits = 1, axes)
+ draw_tour_axes(proj, labels, limits = 1, axes, longlabels=axislablong)
 
  # Render projected points
  x <- data %*% proj

R/display-groupxy.r

@@ -22,6 +22,7 @@
 #' @param palette name of color palette for point colour, used by \code{\link{hcl.colors}}, default "Zissou 1"
 #' @param shapeset numbers corresponding to shapes in base R points, to use for mapping
 #' categorical variable to shapes, default=c(15:17, 23:25)
+#' @param axislablong text labels only for the long axes in a projection, default FALSE
 #' @param ... other arguments passed on to \code{\link{animate}} and
 #' \code{\link{display_groupxy}}
 #' @export
@@ -41,7 +42,8 @@ display_groupxy <- function(centr = TRUE, axes = "center", half_range = NULL,
  col = "black", pch = 20, cex = 1,
  edges = NULL, edges.col = "black", edges.width=1,
  group_by = NULL, plot_xgp = TRUE,
- palette = "Zissou 1", shapeset=c(15:17, 23:25), ...) {
+ palette = "Zissou 1", shapeset=c(15:17, 23:25),
+ axislablong = FALSE, ...) {
  labels <- NULL
 
  # If colors are a variable, convert to colors
@@ -95,7 +97,7 @@ display_groupxy <- function(centr = TRUE, axes = "center", half_range = NULL,
  x <- x / half_range
 
  blank_plot(xlim = c(-1, 1), ylim = c(-1, 1))
- draw_tour_axes(proj, labels, limits = 1, axes)
+ draw_tour_axes(proj, labels, limits = 1, axes, longlabels=axislablong)
  # add a legend, only if a variable was used
  if (is.factor(gps)) {
  numcol <- unique(col)

R/display-pca.r

@@ -18,6 +18,7 @@
 #' @param edges.col colour of edges to be plotted, Defaults to "black.
 #' @param rescale Default FALSE. If TRUE, rescale all variables to range [0,1].
 #' @param palette name of color palette for point colour, used by \code{\link{hcl.colors}}, default "Zissou 1"
+#' @param axislablong text labels only for the long axes in a projection, default FALSE
 #' @param ... other arguments passed on to \code{\link{animate}} and
 #' \code{\link{display_slice}}
 #' @export
@@ -31,7 +32,8 @@ display_pca <- function(center = TRUE, axes = "center", half_range = NULL,
  col = "black", pch = 20, cex = 1,
  pc_coefs = NULL,
  edges = NULL, edges.col = "black",
- palette = "Zissou 1", ...) {
+ palette = "Zissou 1",
+ axislablong = FALSE, ...) {
  labels <- NULL
 
  # If colors are a variable, convert to colors
@@ -63,7 +65,7 @@ display_pca <- function(center = TRUE, axes = "center", half_range = NULL,
  render_data <- function(data, proj, geodesic) {
  # Render axes
  pc_axes <- pc_coefs %*% proj
- draw_tour_axes(pc_axes, labels, limits = 1, axes)
+ draw_tour_axes(pc_axes, labels, limits = 1, axes, longlabels=axislablong)
 
  # Render projected points
  x <- data %*% proj

R/display-sage.R

@@ -13,6 +13,7 @@
 #' @param R scale for the radial transformation.
 #' If not set, defaults to maximum distance from origin to each row of data.
 #' @param palette name of color palette for point colour, used by \code{\link{hcl.colors}}, default "Zissou 1"
+#' @param axislablong text labels only for the long axes in a projection, default FALSE
 #' @param ... other arguments passed on to \code{\link{animate}} and
 #' \code{\link{display_sage}}
 #' @export
@@ -27,7 +28,8 @@
 #' animate_sage(sphere10)
 display_sage <- function(axes = "center", half_range = NULL,
  col = "black", pch = 20, gam = 1, R = NULL,
- palette = "Zissou 1", ...) {
+ palette = "Zissou 1",
+ axislablong = FALSE, ...) {
  labels <- NULL
  peff <- NULL
 
@@ -54,7 +56,7 @@ display_sage <- function(axes = "center", half_range = NULL,
  }
 
  render_data <- function(data, proj, geodesic) {
- draw_tour_axes(proj, labels, 1, axes)
+ draw_tour_axes(proj, labels, 1, axes, longlabels=axislablong)
 
  # Projecte data and center
  x <- data %*% proj

R/display-slice.r

@@ -24,6 +24,7 @@
 #' @param anchor_nav position of the anchor: center, topright or off
 #' @param rescale Default FALSE. If TRUE, rescale all variables to range [0,1].
 #' @param palette name of color palette for point colour, used by \code{\link{hcl.colors}}, default "Zissou 1"
+#' @param axislablong text labels only for the long axes in a projection, default FALSE
 #' @param ... other arguments passed on to \code{\link{animate}} and
 #' \code{\link{display_slice}}
 #' @export
@@ -51,7 +52,8 @@ display_slice <- function(center = TRUE, axes = "center", half_range = NULL,
  cex_slice = 2, cex_other = 1, v_rel = NULL,
  anchor = NULL, anchor_nav = "off",
  edges = NULL, edges.col = "black",
- palette = "Zissou 1", ...) {
+ palette = "Zissou 1",
+ axislablong = FALSE, ...) {
  labels <- NULL
  h <- NULL
 
@@ -89,7 +91,7 @@ display_slice <- function(center = TRUE, axes = "center", half_range = NULL,
  }
 
  render_data <- function(data, proj, geodesic, with_anchor = anchor) {
- draw_tour_axes(proj, labels, limits = 1, axes)
+ draw_tour_axes(proj, labels, limits = 1, axes, longlabels=axislablong)
  if (!is.null(with_anchor)) {
  rng <- apply(data, 2, range)
  colnames(with_anchor) <- colnames(data)

R/display-trails.r

@@ -14,13 +14,14 @@
 #' @param past draw line between current projection and projection \code{past}
 #' steps ago
 #' @param cex magnification of plotting text relative to default. Defaults to 1.
+#' @param axislablong text labels only for the long axes in a projection, default FALSE
 #' @param ... other arguments passed on to \code{\link{animate}} and
 #' \code{\link{display_xy}}
 #' @export
 #' @examples
 #' animate_trails(flea[,1:6], col=flea$species)
 #'
-display_trails <- function(center = TRUE, axes = "center", half_range = NULL, col = "black", pch = 20, cex = 1, past = 3, ...) {
+display_trails <- function(center = TRUE, axes = "center", half_range = NULL, col = "black", pch = 20, cex = 1, past = 3, axislablong = FALSE, ...) {
 
  # Inherit most behaviour from display_xy. This is a little hacky, but
  # the only way until tourr switch to a proper object system.
@@ -35,7 +36,7 @@ display_trails <- function(center = TRUE, axes = "center", half_range = NULL, co
 
  # Only difference is the display method
  render_data <- function(data, proj, geodesic) {
- draw_tour_axes(proj, labels, 1, axes)
+ draw_tour_axes(proj, labels, 1, axes, longlabels=axislablong)
 
  x <- data %*% proj
  if (center) x <- center(x)

R/display-xy.r

@@ -21,9 +21,11 @@
 #' scale the ellipse larger or smaller to capture more or fewer anomalies. Default 3.
 #' @param ellmu This is the centre of the ellipse corresponding to the mean of the
 #' normal population. Default vector of 0's
+#' @param ellmarks mark the extreme points with red crosses, default TRUE
 #' @param palette name of color palette for point colour, used by \code{\link{hcl.colors}}, default "Zissou 1"
 #' @param shapeset numbers corresponding to shapes in base R points, to use for mapping
 #' categorical variable to shapes, default=c(15:17, 23:25)
+#' @param axislablong text labels only for the long axes in a projection, default FALSE
 #' @param ... other arguments passed on to \code{\link{animate}} and
 #' \code{\link{display_xy}}
 #' @importFrom graphics legend
@@ -72,7 +74,9 @@ display_xy <- function(center = TRUE, axes = "center", half_range = NULL,
  edges = NULL, edges.col = "black", edges.width=1,
  obs_labels = NULL,
  ellipse = NULL, ellc = NULL, ellmu = NULL,
- palette="Zissou 1", shapeset=c(15:17, 23:25), ...) {
+ ellmarks = TRUE,
+ palette="Zissou 1", shapeset=c(15:17, 23:25),
+ axislablong = FALSE, ...) {
  # Needed for CRAN checks
  labels <- NULL
  gps <- NULL
@@ -128,7 +132,7 @@ display_xy <- function(center = TRUE, axes = "center", half_range = NULL,
  rect(-1, -1, 1, 1, col = "#FFFFFFE6", border = NA)
  }
  render_data <- function(data, proj, geodesic) {
- draw_tour_axes(proj, labels, limits = 1, axes, ...)
+ draw_tour_axes(proj, labels, limits = 1, axes, longlabels=axislablong, ...)
 
  # Render projected points
  x <- data %*% proj
@@ -227,7 +231,7 @@ display_xy <- function(center = TRUE, axes = "center", half_range = NULL,
  #mdst <- mahal_dist(data, ellipse)
  anomalies <- which(mdst > ellc)
  #cat("1 ", length(anomalies), "\n")
- if (length(anomalies) > 0) {
+ if (length(anomalies) > 0 & ellmarks) {
  points(x[anomalies,],
  col = "red",
  pch = 4,
@@ -267,6 +271,7 @@ animate_xy <- function(data, tour_path = grand_tour(), ...) {
 #' @param axis.col colour of axes, default "grey50"
 #' @param axis.lwd linewidth of axes, default 1
 #' @param axis.text.col colour of axes text, default "grey50"
+#' @param longlabels text labels only for the long axes in a projection, default FALSE
 #' @param ... other arguments passed
 #' @export
 #' @examples
@@ -284,8 +289,10 @@ animate_xy <- function(data, tour_path = grand_tour(), ...) {
 #' xlim = c(-3, 3), ylim = c(-3, 3),
 #' xlab="P1", ylab="P2")
 #' draw_tour_axes(prj, colnames(flea)[1:6], limits=3, position="bottomleft")
+#' draw_tour_axes(prj, colnames(flea)[1:6], axislablong=TRUE)
 draw_tour_axes <- function(proj, labels, limits=1, position="center",
- axis.col= "grey50", axis.lwd=1, axis.text.col= "grey50", ...) {
+ axis.col="grey50", axis.lwd=1, axis.text.col="grey50",
+ longlabels, ...) {
  position <- match.arg(position, c("center", "bottomleft", "off"))
  if (position == "off") {
  return()
@@ -311,6 +318,12 @@ draw_tour_axes <- function(proj, labels, limits=1, position="center",
  theta <- seq(0, 2 * pi, length = 50)
  lines(adj(cos(theta)), adj(sin(theta)),
  col = axis.col, lwd = axis.lwd)
+ if (longlabels) {
+ for (i in 1:length(labels)) {
+ if ((proj[i, 1]^2 + proj[i, 2]^2) < 0.3)
+ labels[i] <- ""
+ }
+ }
  text(adj(proj[, 1]), adj(proj[, 2]), label = labels,
  col = axis.text.col)
 }

R/tour-guided-anomaly.r

@@ -40,7 +40,7 @@ guided_anomaly_tour <- function(index_f, d = 2, alpha = 0.5, cooling = 0.99,
 
  generator <- function(current, data, tries, ...) {
  if (is.null(current)) {
- return(basis_init(ncol(data), d))
+ return(basis_random(ncol(data), d))
  }
 
  if (is.null(h)) {