ellipse drawing and standardised flea data

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: tourr
 Title: Tour Methods for Multivariate Data Visualisation
-Version: 1.1.0
+Version: 1.2.0
 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")),
@@ -21,7 +21,7 @@ Imports:
  utils,
  grDevices
 Suggests:
- TeachingDemos,
+ aplpack,
  ash,
  energy,
  testthat,

NEWS.md

@@ -1,4 +1,11 @@
-# tourr 1.1.0
+# tourr 1.2.0 
+
+* major change: rescale is now FALSE by default
+* flea is now standardised measurements, and flea_raw is the original units
+* TeachingDemos removed as a Suggests, and replaced with aplpack for drawing Chernoff faces
+* addition of a pre-specified ellipse can be added to the 2D display
+
+# tourr 1.1.0 
 
 * Updated version to indicate some nice new additions for the package
 

R/data.r

@@ -1,7 +1,8 @@
 #' Flea beatle measurements
 #'
 #' This data is from a paper by A. A. Lubischew, "On the Use of Discriminant
-#' Functions in Taxonomy", Biometrics, Dec 1962, pp.455-477.
+#' Functions in Taxonomy", Biometrics, Dec 1962, pp.455-477. Data is
+#' standardized, and original units are in flea_raw.
 #'
 #' \itemize{
 #' \item tars1, width of the first joint of the first tarsus in microns
@@ -16,7 +17,7 @@
 #' }
 #'
 #' @name Flea measurements
-#' @aliases flea
+#' @aliases flea, flea_raw
 #' @docType data
 #' @format A 74 x 7 numeric array
 #' @keywords datasets
@@ -25,7 +26,7 @@
 #' head(flea)
 #' animate_xy(flea[, -7])
 #' animate_xy(flea[, -7], col = flea[, 7])
-NULL
+"flea"
 
 #' Turnable laser measurements from Bellcore
 #'

R/display-faces.r

@@ -14,19 +14,19 @@
 #' # The drawing code is fairly slow, so this animation works best with a
 #' # limited number of cases
 #' flea_s <- rescale(flea[,1:6])
-#' animate_faces(flea_s[1:2, 1:6])
-#' animate_faces(flea_s[1:4, 1:6])
+#' animate_faces(flea_s[19:24, 1:6])
 #'
-#' animate_faces(flea_s[1:2, 1:6], grand_tour(5))
+#' animate_faces(flea_s[19:24, 1:6], grand_tour(5))
 display_faces <- function(...) {
- if (!requireNamespace("TeachingDemos", quietly = TRUE)) {
- stop("Please install the TeachingDemos package", call. = FALSE)
+ if (!requireNamespace("aplpack", quietly = TRUE)) {
+ stop("Please install the aplpack package", call. = FALSE)
  }
 
  render_data <- function(data, proj, geodesic) {
  x <- data %*% proj
  x <- (x + 2) / 4
- TeachingDemos::faces2(x, scale = "none")
+ aplpack::faces(x, scale = TRUE, face.type = 0,
+ cex = 0.1, print.info = FALSE)
  }
 
  list(

R/display-xy.r

@@ -13,8 +13,10 @@
 #' @param pch shape of the point to be plotted, can be a factor or integer. Defaults to 20.
 #' @param cex size of the point to be plotted. Defaults to 1.
 #' @param edges.col colour of edges to be plotted, Defaults to "black"
-#' @param obs_labels vector of text labels to display
 #' @param edges.width line width for edges, default 1
+#' @param obs_labels vector of text labels to display
+#' @param ellipse pxp variance-covariance matrix defining ellipse, default NULL. Useful for
+#' comparing data with some null hypothesis
 #' @param palette name of color palette for point colour, used by \code{\link{hcl.colors}}, default "Zissou 1"
 #' @param ... other arguments passed on to \code{\link{animate}} and
 #' \code{\link{display_xy}}
@@ -56,10 +58,14 @@
 #' flea[, 1:6], grand_tour(),
 #' display_xy(axes = "bottomleft", edges = edges)
 #' )
+#' # An ellipse can be drawn on the data using a specified var-cov
+#' animate_xy(flea[, 1:6], axes = "off", ellipse=cov(flea[,1:6]))
 display_xy <- function(center = TRUE, axes = "center", half_range = NULL,
  col = "black", pch = 20, cex = 1,
  edges = NULL, edges.col = "black", edges.width=1,
- obs_labels = NULL, palette="Zissou 1", ...) {
+ obs_labels = NULL,
+ ellipse = NULL,
+ palette="Zissou 1", ...) {
  # Needed for CRAN checks
  labels <- NULL
  gps <- NULL
@@ -140,7 +146,34 @@ display_xy <- function(center = TRUE, axes = "center", half_range = NULL,
  # Add index value if using guided tour
  #if (!is.na(cur_index))
  # text(0, 0, labels=round(cur_index, 2))
+ # Draw a pre-determined ellipse on the data
+ if (!is.null(ellipse)) {
+ if (nrow(ellipse) == nrow(proj)) {
+
+ # Project ellipse into 2D
+ evc <- eigen(ellipse)
+ ellinv <- (evc$vectors) %*% diag(evc$values) %*% t(evc$vectors)
+ e2 <- t(proj) %*% ellinv %*% proj
+ evc2 <- eigen(e2)
+ ell2d <- (evc2$vectors) %*% diag(sqrt(evc2$values)) %*% t(evc2$vectors)
+
+ # Compute the points on an ellipse
+ sph <- geozoo::sphere.hollow(2, 200)$points
+ sph <- sph[order(sph[,2]),]
+ sph1 <- sph[sph[,2]>=0,]
+ sph2 <- sph[sph[,2]<0,]
+ sph1 <- sph1[order(sph1[,1]),]
+ sph2 <- sph2[order(sph2[,1], decreasing=T),]
+ sph <- rbind(sph1, sph2)
+ sph <- rbind(sph, sph[1,])
+ sph2d <- sph%*%ell2d/half_range
 
+ lines(sph2d)
+
+ }
+ else
+ message("Check the variance-covariance matrix generating the ellipse\n")
+ }
  }
 
  list(

R/tour-radial.r

@@ -12,10 +12,10 @@
 #' @param ... additional arguments for drawing
 #' @export
 #' @examples
-#' animate_xy(flea[, 1:6], radial_tour(basis_random(6, 2), mvar = 4))
-#' animate_xy(flea[, 1:6], radial_tour(basis_random(6, 2), mvar = c(3,4)))
-#' animate_dist(flea[, 1:6], radial_tour(basis_random(6, 1), mvar = 4))
-#' animate_scatmat(flea[, 1:6], radial_tour(basis_random(6, 3), mvar = 4))
+#' animate_xy(flea[, 1:6], radial_tour(basis_random(6, 2), mvar = 4), rescale=TRUE)
+#' animate_xy(flea[, 1:6], radial_tour(basis_random(6, 2), mvar = c(3,4)), rescale=TRUE)
+#' animate_dist(flea[, 1:6], radial_tour(basis_random(6, 1), mvar = 4), rescale=TRUE)
+#' animate_scatmat(flea[, 1:6], radial_tour(basis_random(6, 3), mvar = 4), rescale=TRUE)
 radial_tour <- function(start, mvar = 1, ...) {
  first <- TRUE
  out <- TRUE