Merge branch 'ggobi:master' into patch-1

.github/workflows/rhub.yaml

@@ -0,0 +1,95 @@
+# R-hub's generic GitHub Actions workflow file. It's canonical location is at
+# https://github.com/r-hub/actions/blob/v1/workflows/rhub.yaml
+# You can update this file to a newer version using the rhub2 package:
+#
+# rhub::rhub_setup()
+#
+# It is unlikely that you need to modify this file manually.
+
+name: R-hub
+run-name: "${{ github.event.inputs.id }}: ${{ github.event.inputs.name || format('Manually run by {0}', github.triggering_actor) }}"
+
+on:
+ workflow_dispatch:
+ inputs:
+ config:
+ description: 'A comma separated list of R-hub platforms to use.'
+ type: string
+ default: 'linux,windows,macos'
+ name:
+ description: 'Run name. You can leave this empty now.'
+ type: string
+ id:
+ description: 'Unique ID. You can leave this empty now.'
+ type: string
+
+jobs:
+
+ setup:
+ runs-on: ubuntu-latest
+ outputs:
+ containers: ${{ steps.rhub-setup.outputs.containers }}
+ platforms: ${{ steps.rhub-setup.outputs.platforms }}
+
+ steps:
+ # NO NEED TO CHECKOUT HERE
+ - uses: r-hub/actions/setup@v1
+ with:
+ config: ${{ github.event.inputs.config }}
+ id: rhub-setup
+
+ linux-containers:
+ needs: setup
+ if: ${{ needs.setup.outputs.containers != '[]' }}
+ runs-on: ubuntu-latest
+ name: ${{ matrix.config.label }}
+ strategy:
+ fail-fast: false
+ matrix:
+ config: ${{ fromJson(needs.setup.outputs.containers) }}
+ container:
+ image: ${{ matrix.config.container }}
+
+ steps:
+ - uses: r-hub/actions/checkout@v1
+ - uses: r-hub/actions/platform-info@v1
+ with:
+ token: ${{ secrets.RHUB_TOKEN }}
+ job-config: ${{ matrix.config.job-config }}
+ - uses: r-hub/actions/setup-deps@v1
+ with:
+ token: ${{ secrets.RHUB_TOKEN }}
+ job-config: ${{ matrix.config.job-config }}
+ - uses: r-hub/actions/run-check@v1
+ with:
+ token: ${{ secrets.RHUB_TOKEN }}
+ job-config: ${{ matrix.config.job-config }}
+
+ other-platforms:
+ needs: setup
+ if: ${{ needs.setup.outputs.platforms != '[]' }}
+ runs-on: ${{ matrix.config.os }}
+ name: ${{ matrix.config.label }}
+ strategy:
+ fail-fast: false
+ matrix:
+ config: ${{ fromJson(needs.setup.outputs.platforms) }}
+
+ steps:
+ - uses: r-hub/actions/checkout@v1
+ - uses: r-hub/actions/setup-r@v1
+ with:
+ job-config: ${{ matrix.config.job-config }}
+ token: ${{ secrets.RHUB_TOKEN }}
+ - uses: r-hub/actions/platform-info@v1
+ with:
+ token: ${{ secrets.RHUB_TOKEN }}
+ job-config: ${{ matrix.config.job-config }}
+ - uses: r-hub/actions/setup-deps@v1
+ with:
+ job-config: ${{ matrix.config.job-config }}
+ token: ${{ secrets.RHUB_TOKEN }}
+ - uses: r-hub/actions/run-check@v1
+ with:
+ job-config: ${{ matrix.config.job-config }}
+ token: ${{ secrets.RHUB_TOKEN }}

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: tourr
 Title: Tour Methods for Multivariate Data Visualisation
-Version: 1.1.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")),
@@ -21,7 +21,7 @@ Imports:
  utils,
  grDevices
 Suggests:
- TeachingDemos,
+ aplpack,
  ash,
  energy,
  testthat,
@@ -39,6 +39,6 @@ License: MIT + file LICENSE
 LazyData: true
 URL: https://github.com/ggobi/tourr, https://ggobi.github.io/tourr/
 BugReports: https://github.com/ggobi/tourr/issues
-RoxygenNote: 7.2.3
+RoxygenNote: 7.3.1
 Encoding: UTF-8
 VignetteBuilder: knitr

LICENSE

@@ -1,2 +1,2 @@
-YEAR: 2010-2021
+YEAR: 2010-2024
 COPYRIGHT HOLDER: Hadley Wickham, Di Cook

NAMESPACE

@@ -33,6 +33,7 @@ export(animate_stars)
 export(animate_stereo)
 export(animate_trails)
 export(animate_xy)
+export(anomaly_index)
 export(areColors)
 export(basis_init)
 export(basis_random)
@@ -66,6 +67,7 @@ export(frozen_guided_tour)
 export(frozen_tour)
 export(geodesic_path)
 export(grand_tour)
+export(guided_anomaly_tour)
 export(guided_section_tour)
 export(guided_tour)
 export(holes)
@@ -75,6 +77,7 @@ export(lda_pp)
 export(linear_breaks)
 export(little_tour)
 export(local_tour)
+export(mahal_dist)
 export(manual_slice)
 export(mapColors)
 export(mapShapes)
@@ -133,7 +136,9 @@ importFrom(graphics,rect)
 importFrom(graphics,segments)
 importFrom(graphics,stars)
 importFrom(graphics,text)
+importFrom(stats,mahalanobis)
 importFrom(stats,na.omit)
+importFrom(stats,qchisq)
 importFrom(stats,quantile)
 importFrom(stats,residuals)
 importFrom(stats,rnorm)

NEWS.md

@@ -1,4 +1,19 @@
-# tourr 1.1.0
+# 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.
+* 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.
+* palette can now be a vector of values.
+* a new projection pursuit index for finding anomalies relative to a null variance-covariance matrix. May still need more work.
+* point shapes can now be specified like palettes
+
+# tourr 1.1.0 
 
 * Updated version to indicate some nice new additions for the package
 

R/anomaly-pursuit.r

@@ -0,0 +1,15 @@
+#' Anomaly index.
+#'
+#' Calculates an index that looks for the best projection of
+#' observations that are outside a pre-determined p-D ellipse.
+#'
+#' @export
+anomaly_index <- function() {
+
+ function(mat, ell2d, ellmu2d) {
+
+ mat_tab <- #mean(mahal_dist(mat, ell2d))
+ mean(mahalanobis(mat, center=ellmu2d, cov=ell2d))
+ }
+}
+

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-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-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-groupxy.r

@@ -20,6 +20,9 @@
 #' @param edges.col colour of edges to be plotted, Defaults to "black"
 #' @param edges.width line width for edges, default 1
 #' @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
@@ -39,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", ...) {
+ palette = "Zissou 1", shapeset=c(15:17, 23:25),
+ axislablong = FALSE, ...) {
  labels <- NULL
 
  # If colors are a variable, convert to colors
@@ -53,7 +57,7 @@ display_groupxy <- function(centr = TRUE, axes = "center", half_range = NULL,
  }
  # If shapes are a variable, convert shapes
  if (is.factor(pch)) {
- shapes <- mapShapes(pch)
+ shapes <- mapShapes(pch, shapeset)
  } else {
  shapes <- pch
  }
@@ -93,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)