diff --git a/.github/workflows/rhub.yaml b/.github/workflows/rhub.yaml new file mode 100644 index 00000000..74ec7b05 --- /dev/null +++ b/.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 }} diff --git a/DESCRIPTION b/DESCRIPTION index f2c9364f..e62e0b17 100644 --- a/DESCRIPTION +++ b/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 diff --git a/LICENSE b/LICENSE index a04a547a..fd367831 100644 --- a/LICENSE +++ b/LICENSE @@ -1,2 +1,2 @@ -YEAR: 2010-2021 +YEAR: 2010-2024 COPYRIGHT HOLDER: Hadley Wickham, Di Cook diff --git a/NAMESPACE b/NAMESPACE index ad983aa3..dfd15912 100644 --- a/NAMESPACE +++ b/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) diff --git a/NEWS.md b/NEWS.md index 1cf3f2e0..003b3d2c 100644 --- a/NEWS.md +++ b/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 diff --git a/R/anomaly-pursuit.r b/R/anomaly-pursuit.r new file mode 100644 index 00000000..48d86aeb --- /dev/null +++ b/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)) + } +} + diff --git a/R/data.r b/R/data.r index bd9aa930..f1f1f50e 100644 --- a/R/data.r +++ b/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 #' diff --git a/R/display-density2d.r b/R/display-density2d.r index b2f9f90d..274668da 100644 --- a/R/display-density2d.r +++ b/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 diff --git a/R/display-faces.r b/R/display-faces.r index 5c72e62b..1a18e505 100644 --- a/R/display-faces.r +++ b/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( diff --git a/R/display-groupxy.r b/R/display-groupxy.r index 3d8d283c..d7c6d54b 100644 --- a/R/display-groupxy.r +++ b/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) diff --git a/R/display-pca.r b/R/display-pca.r index e898c2cf..abda235d 100644 --- a/R/display-pca.r +++ b/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 diff --git a/R/display-sage.R b/R/display-sage.R index 10c456e0..05ad631b 100644 --- a/R/display-sage.R +++ b/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 diff --git a/R/display-slice.r b/R/display-slice.r index 2628ede9..face3924 100644 --- a/R/display-slice.r +++ b/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) diff --git a/R/display-trails.r b/R/display-trails.r index 1688626c..01b24d0f 100644 --- a/R/display-trails.r +++ b/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) diff --git a/R/display-xy.r b/R/display-xy.r index b3038db6..54beaa05 100644 --- a/R/display-xy.r +++ b/R/display-xy.r @@ -13,12 +13,23 @@ #' @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 ellc This can be considered the equivalent of a critical value, used to +#' 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 +#' @importFrom stats mahalanobis qchisq #' @export #' @examples #' animate_xy(flea[, 1:6]) @@ -56,10 +67,16 @@ #' 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, ellc = NULL, ellmu = NULL, + ellmarks = TRUE, + palette="Zissou 1", shapeset=c(15:17, 23:25), + axislablong = FALSE, ...) { # Needed for CRAN checks labels <- NULL gps <- NULL @@ -76,7 +93,7 @@ display_xy <- function(center = 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 } @@ -84,6 +101,21 @@ display_xy <- function(center = TRUE, axes = "center", half_range = NULL, init <- function(data) { half_range <<- compute_half_range(half_range, data, center) labels <<- abbreviate(colnames(data), 3) + + if (!is.null(ellipse)) { + if (nrow(ellipse) == ncol(data)) { + + if (is.null(ellc)) + ellc <<- qchisq(0.95, ncol(data)) + else + stopifnot(ellc > 0) # Needs to be positive + if (is.null(ellmu)) + ellmu <<- rep(0, ncol(data)) + else + stopifnot(length(ellmu) == ncol(data)) # Right dimension + message("Using ellc = ", format(ellc, digits = 2)) + } + } } if (!is.null(edges)) { @@ -100,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 @@ -140,7 +172,75 @@ 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)) { + + # if (is.null(ellc)) + # ellc <- qchisq(0.95, nrow(proj)) + # else + # stopifnot(ellc > 0) # Needs to be positive + # if (is.null(ellmu)) + # ellmu <- rep(0, nrow(proj)) + # else + # stopifnot(length(ellmu) == nrow(proj)) # Right dimension + # message("Using ellc = ", format(ellc, digits = 2)) + + # Project ellipse into 2D + # Notation in paper: ellipse=A, ellinv=A^(-1), + # e2=P^TA^(-1)P, ell2d=B + # ellipse=var-cov of normal pop + # ellinv for defining pD ellipse, for dist calc + # e2 is projected var-cov + # ell2d is B, used to project ellipse points + evc <- eigen(ellipse) # + ellinv <- (evc$vectors) %*% diag(evc$values) %*% t(evc$vectors) + e2 <- t(proj) %*% ellipse %*% proj + evc2 <- eigen(e2) + ell2d <- as.matrix((evc2$vectors)) %*% diag(sqrt(evc2$values*ellc)) %*% t(as.matrix(evc2$vectors)) + #e3 <- eigen(ell2d) + #ell2dinv <- (e3$vectors) %*% diag(e3$values) %*% t(e3$vectors) + # Compute the points on an ellipse + # Generate points on a circle + sph <- geozoo::sphere.hollow(2, 200)$points + # Organise so lines connecting consecutive + # points creates the circle + 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,]) + + # Transform circle points into an ellipse + sph2d <- sph%*%ell2d + # Centre on the given mean + ellmu2d <- t(as.matrix(ellmu)) %*% proj + sph2d <- sweep(sph2d, 2, ellmu2d, `+`) + # Scale ellipse into plot space + sph2d <- sph2d/half_range + + lines(sph2d) + + # Colour points outside the pD ellipse + mdst <- mahalanobis(data, + center=ellmu, + cov=ellipse) + #mdst <- mahal_dist(data, ellipse) + anomalies <- which(mdst > ellc) + #cat("1 ", length(anomalies), "\n") + if (length(anomalies) > 0 & ellmarks) { + points(x[anomalies,], + col = "red", + pch = 4, + cex = 2) + } + } + else + message("Check the variance-covariance matrix generating the ellipse\n") + } } list( @@ -168,6 +268,10 @@ animate_xy <- function(data, tour_path = grand_tour(), ...) { #' projected data, default 1 #' @param position position of the axes: center (default), #' bottomleft or off +#' @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 @@ -185,7 +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 <- function(proj, labels, limits=1, position="center", ...) { +#' 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", + longlabels, ...) { position <- match.arg(position, c("center", "bottomleft", "off")) if (position == "off") { return() @@ -201,13 +308,22 @@ draw_tour_axes <- function(proj, labels, limits=1, position="center", ...) { adj <- function(x) axis_pos + x * axis_scale - segments(adj(0), adj(0), adj(proj[, 1]), adj(proj[, 2]), col = "grey50") + segments(adj(0), adj(0), adj(proj[, 1]), adj(proj[, 2]), + col = axis.col, lwd = axis.lwd) # if (!is.null(mvar)) { # colour manip var # if ((mvar < (nrow(proj)+1)) & (mvar > 0)) { # segments(adj(0), adj(0), adj(proj[, 1]), adj(proj[, 2]), col = "orange") # } # } theta <- seq(0, 2 * pi, length = 50) - lines(adj(cos(theta)), adj(sin(theta)), col = "grey50") - text(adj(proj[, 1]), adj(proj[, 2]), label = labels, col = "grey50") + 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.15) + labels[i] <- "" + } + } + text(adj(proj[, 1]), adj(proj[, 2]), label = labels, + col = axis.text.col) } diff --git a/R/interesting-indices.r b/R/interesting-indices.r index 49f6d234..3cb1997d 100644 --- a/R/interesting-indices.r +++ b/R/interesting-indices.r @@ -44,8 +44,8 @@ splines2d <- function() { #' #' Compares the similarity between the projected distribution and a normal distribution. #' \itemize{ -#' \item{norm_bin }{compares the count in 100 histogram bins} -#' \item{norm_kol }{compares the cdf based on the Kolmogorov–Smirnov test (KS test)} +#' \item norm_bin: compares the count in 100 histogram bins +#' \item norm_kol: compares the cdf based on the Kolmogorov–Smirnov test (KS test) #' } #' @param nr The number of rows in the target matrix #' diff --git a/R/linear-algebra.r b/R/linear-algebra.r index 5b1b0236..1aa441ff 100644 --- a/R/linear-algebra.r +++ b/R/linear-algebra.r @@ -111,3 +111,25 @@ orthonormalise_by <- function(x, by) { #' @keywords algebra #' @export proj_dist <- function(x, y) sqrt(sum((x %*% t(x) - y %*% t(y))^2)) + +#' Calculate the Mahalanobis distance between points and center. +#' +#' Computes the Mahalanobis distance using a provided variance-covariance +#' matrix of observations from 0. +# +#' @param x matrix of data +#' @param vc pre-determined variance-covariance matrix +#' @keywords algebra +#' @export +mahal_dist <- function(x, vc) { + n <- dim(x)[1] + p <- dim(x)[2] + mn <- rep(0, p) + ev <- eigen(vc) + vcinv <- ev$vectors %*% diag(1/ev$values) %*% t(ev$vectors) + x <- x - matrix(rep(mn, n), ncol = p, byrow = T) + dx <- NULL + for (i in 1:n) + dx <- c(dx, x[i, ] %*% vcinv %*% as.matrix(x[i, ])) + return(dx) +} diff --git a/R/tour-guided-anomaly.r b/R/tour-guided-anomaly.r new file mode 100644 index 00000000..5260c775 --- /dev/null +++ b/R/tour-guided-anomaly.r @@ -0,0 +1,123 @@ +#' A guided anomaly tour path. +#' +#' The guided anomaly tour is a variation of the guided tour that is +#' using an ellipse to determine anomalies on which to select target planes. +#' +#' Usually, you will not call this function directly, but will pass it to +#' a method that works with tour paths like \code{\link{animate_xy}}, +#' \code{\link{save_history}} or \code{\link{render}}. +#' +#' @param index_f the section pursuit index function to optimise. The function +#' needs to take two arguments, the projected data, indexes of anomalies. +#' @param d target dimensionality +#' @param alpha the initial size of the search window, in radians +#' @param cooling the amount the size of the search window should be adjusted +#' by after each step +#' @param search_f the search strategy to use +#' @param max.tries the maximum number of unsuccessful attempts to find +#' a better projection before giving up +#' @param max.i the maximum index value, stop search if a larger value is found +#' @param ellipse pxp variance-covariance matrix defining ellipse, default NULL. +#' Useful for comparing data with some hypothesized null. +#' @param ellc This can be considered the equivalent of a critical value, used to +#' 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 ... arguments sent to the search_f +#' @seealso \code{\link{slice_index}} for an example of an index functions. +#' \code{\link{search_geodesic}}, \code{\link{search_better}}, +#' \code{\link{search_better_random}} for different search strategies +#' @importFrom stats mahalanobis qchisq +#' @export +#' @examples +#' animate_xy(flea[, 1:6], guided_anomaly_tour(anomaly_index(), +#' ellipse=cov(flea[,1:6])), ellipse=cov(flea[,1:6]), axes="off") +guided_anomaly_tour <- function(index_f, d = 2, alpha = 0.5, cooling = 0.99, + max.tries = 25, max.i = Inf, + ellipse, ellc=NULL, ellmu=NULL, + search_f = search_geodesic, ...) { + h <- NULL + + generator <- function(current, data, tries, ...) { + if (is.null(current)) { + return(basis_random(ncol(data), d)) + } + + if (is.null(h)) { + half_range <- compute_half_range(NULL, data, FALSE) + } + + index <- function(proj) { + if (nrow(ellipse) == nrow(proj)) { + + if (is.null(ellc)) + ellc <<- qchisq(0.95, nrow(proj)) + else + stopifnot(ellc > 0) # Needs to be positive + if (is.null(ellmu)) + ellmu <<- rep(0, nrow(proj)) + else + stopifnot(length(ellmu) == nrow(proj)) # Right dimension + #message("Using ellc = ", format(ellc, digits = 2)) + + # Check which observations are outside pD ellipse + mdst <- mahalanobis(data, + center=ellmu, + cov=ellipse) + #mdst <- mahal_dist(data, ellipse) + anomalies <- which(mdst > ellc) + stopifnot(length(anomalies) > 0) + #cat(length(anomalies), "\n") + + # Project ellipse into 2D + evc <- eigen(ellipse) # + ellinv <- (evc$vectors) %*% as.matrix(diag(evc$values)) %*% t(evc$vectors) + e2 <- t(proj) %*% ellipse %*% proj + evc2 <- eigen(e2) + ell2d <- as.matrix(evc2$vectors) %*% diag(sqrt(evc2$values*ellc)) %*% t(as.matrix(evc2$vectors)) + + ell2dinv <- (evc2$vectors) %*% diag(evc2$values*ellc) %*% t(evc2$vectors) + ellmu2d <- t(as.matrix(ellmu)) %*% proj + #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) + #e3 <- eigen(ell2d) + #ell2dinv <- (e3$vectors) %*% diag(e3$values) %*% t(e3$vectors) + index_f(as.matrix(data[anomalies,]) %*% proj, e2, ellmu2d) + } + } + + cur_index <- index(current) + + if (cur_index > max.i) { + cat("Found index ", cur_index, ", larger than selected maximum ", max.i, ". Stopping search.\n", + sep = "" + ) + cat("Final projection: \n") + if (ncol(current) == 1) { + for (i in 1:length(current)) { + cat(sprintf("%.3f", current[i]), " ") + } + cat("\n") + } + else { + for (i in 1:nrow(current)) { + for (j in 1:ncol(current)) { + cat(sprintf("%.3f", current[i, j]), " ") + } + cat("\n") + } + } + return(NULL) + } + + basis <- search_f(current, alpha, index, tries, max.tries, cur_index = cur_index, ...) + alpha <<- alpha * cooling + + list(target = basis$target, index = index) + } + + new_geodesic_path("guided", generator) +} diff --git a/R/tour-guided-section.r b/R/tour-guided-section.r index 158e21b9..1b496a6c 100644 --- a/R/tour-guided-section.r +++ b/R/tour-guided-section.r @@ -7,7 +7,7 @@ #' a method that works with tour paths like \code{\link{animate_slice}}, #' \code{\link{save_history}} or \code{\link{render}}. #' -#' @param index_f the section purusit index function to optimise. The function +#' @param index_f the section pursuit index function to optimise. The function #' needs to take three arguments, the projected data, the vector of distances #' from the current projection plane, and the slice thickness h. #' @param d target dimensionality @@ -19,7 +19,7 @@ #' a better projection before giving up #' @param max.i the maximum index value, stop search if a larger value is found #' @param v_rel relative volume of the slice. If not set, suggested value -#' is caluclated and printed to the screen. +#' is calculated and printed to the screen. #' @param anchor A vector specifying the reference point to anchor the slice. #' If NULL (default) the slice will be anchored at the data center. #' @param ... arguments sent to the search_f diff --git a/R/tour-radial.r b/R/tour-radial.r index 6f8af67f..685d892d 100644 --- a/R/tour-radial.r +++ b/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 diff --git a/R/util.r b/R/util.r index c2290cd4..c67e039e 100644 --- a/R/util.r +++ b/R/util.r @@ -122,16 +122,25 @@ areColors <- function(x) { #' @export mapColors <- function(x, palette) { n <- length(unique(x)) - pal <- grDevices::hcl.colors(n, palette=palette) + # Handle manual colour setting + if (length(palette) > 1) { + stopifnot(length(palette) == n) + pal <- palette + } + else { + pal <- grDevices::hcl.colors(n, palette=palette) + } pal[as.numeric(as.factor(x))] } #' Map vector of factors to pch #' #' @param x vector +#' @param shapeset vector of integers indicating point shapes #' @export -mapShapes <- function(x) { +mapShapes <- function(x, shapeset) { n <- length(unique(x)) - shapes <- c(15:17, 23:25) + stopifnot(length(shapeset) >= n) + shapes <- shapeset shapes[as.numeric(x)] } diff --git a/cran-comments.md b/cran-comments.md index a4715712..8f87ae85 100644 --- a/cran-comments.md +++ b/cran-comments.md @@ -1,57 +1,43 @@ ## Overview -This is a small update, with one new displayand several bug fixes. There are no major structural changes to the code, though. +The main change was removing the dependency on TeachingDemos as requested by CRAN. -\dontrun is used for example code where the method would break, and thus the code should not be run. It is important for users to be able to see these examples. +Other changes are minor, except that a different default for all animations might affect current users. -── R CMD check results ──────────────────────────── tourr 1.1.0 ──── -Duration: 1m 14.7s +── R CMD check results ──────────────── tourr 1.2.0 ──── +Duration: 1m 18.7s 0 errors ✔ | 0 warnings ✔ | 0 notes ✔ ## Test environment -* local R installation: R version 4.3.1 (2023-06-16) -* Windows Server 2022, R-devel, 64 bit -* Fedora Linux, R-devel, clang, gfortran -* Ubuntu Linux 20.04.1 LTS, R-release, GCC - -using `check_rhub()`, returns some notes: - -* checking HTML version of manual ... NOTE -Skipping checking HTML validation: no command 'tidy' found -Skipping checking math rendering: package 'V8' unavailable - -* checking for non-standard things in the check directory ... NOTE -Found the following files/directories: - ''NULL'' - -* checking for detritus in the temp directory ... NOTE -Found the following files/directories: - 'lastMiKTeXException' - -Which I understand can be ignored +* R version 4.3.3 (Angel Food Cake) +* Windows: Using https://win-builder.r-project.org/ +* Linux: Using `rhub::rc_submit()` ## Downstream dependencies All downstream dependencies have been checked. > revdepcheck::revdep_check() -── CHECK ──────────────────────────────────────── 11 packages ── -✔ cheem 0.3.0 ── E: 0 | W: 0 | N: 0 -✔ composits 0.1.1 ── E: 1 | W: 0 | N: 0 +── INIT ───────────────────────────────── Computing revdeps ── +── INSTALL ───────────────────────────────────── 2 versions ── +Installing CRAN version of tourr +Installing DEV version of tourr +── CHECK ────────────────────────────────────── 12 packages ── +✔ cheem 0.4.0.0 ── E: 0 | W: 0 | N: 0 +✔ composits 0.1.1 ── E: 0 | W: 0 | N: 0 ✔ detourr 0.1.0 ── E: 0 | W: 0 | N: 1 I diveR 0.1.2 ── E: 1 | W: 0 | N: 0 ✔ ferrn 0.0.2 ── E: 0 | W: 0 | N: 0 ✔ geozoo 0.5.1 ── E: 0 | W: 0 | N: 0 ✔ liminal 0.1.2 ── E: 0 | W: 0 | N: 0 -I loon.tourr 0.1.3 ── E: 1 | W: 0 | N: 0 -✔ mulgar 1.0.1 ── E: 0 | W: 0 | N: 0 -I REPPlab 0.9.4 ── E: 1 | W: 0 | N: 0 -✔ spinifex 0.3.6 ── E: 0 | W: 0 | N: 1 +I loon.tourr 0.1.4 ── E: 1 | W: 0 | N: 0 +✔ mulgar 1.0.2 ── E: 0 | W: 0 | N: 0 +I REPPlab 0.9.6 ── E: 1 | W: 0 | N: 0 +✔ spinifex 0.3.7.0 ── E: 0 | W: 0 | N: 0 ✔ woylier 0.0.5 ── E: 0 | W: 0 | N: 0 -OK: 12 +OK: 12 BROKEN: 0 -Total time: 13 min - -REPPlab cannot be fully checked because it uses RJava, which is difficult to install at present. REPPlab doesn't Depend, but only Suggests, the tourr package. diveR appears to be a helper package for interactive graphics but it fails to load properly for me, so I can't easily check the problems. +Total time: 12 min +── REPORT ──────────────────────────────────────────────────── diff --git a/data/flea.rda b/data/flea.rda index 393487df..6684e430 100644 Binary files a/data/flea.rda and b/data/flea.rda differ diff --git a/data/flea_raw.rda b/data/flea_raw.rda new file mode 100644 index 00000000..d97c31e8 Binary files /dev/null and b/data/flea_raw.rda differ diff --git a/man/Flea-measurements.Rd b/man/Flea-measurements.Rd index ddd85c3c..814a1eee 100644 --- a/man/Flea-measurements.Rd +++ b/man/Flea-measurements.Rd @@ -4,13 +4,19 @@ \name{Flea measurements} \alias{Flea measurements} \alias{flea} +\alias{flea,} +\alias{flea_raw} \title{Flea beatle measurements} \format{ A 74 x 7 numeric array } +\usage{ +flea +} \description{ 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. } \details{ \itemize{ diff --git a/man/anomaly_index.Rd b/man/anomaly_index.Rd new file mode 100644 index 00000000..299c5b01 --- /dev/null +++ b/man/anomaly_index.Rd @@ -0,0 +1,12 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/anomaly-pursuit.r +\name{anomaly_index} +\alias{anomaly_index} +\title{Anomaly index.} +\usage{ +anomaly_index() +} +\description{ +Calculates an index that looks for the best projection of +observations that are outside a pre-determined p-D ellipse. +} diff --git a/man/display_density2d.Rd b/man/display_density2d.Rd index 1f6a5ac4..1f1ca49e 100644 --- a/man/display_density2d.Rd +++ b/man/display_density2d.Rd @@ -15,6 +15,7 @@ display_density2d( contour_quartile = c(0.25, 0.5, 0.75), edges = NULL, palette = "Zissou 1", + axislablong = FALSE, ... ) @@ -42,6 +43,8 @@ If not set, defaults to maximum distance from origin to each row of data.} \item{palette}{name of color palette for point colour, used by \code{\link{hcl.colors}}, default "Zissou 1"} +\item{axislablong}{text labels only for the long axes in a projection, default FALSE} + \item{...}{other arguments passed on to \code{\link{animate}} and \code{\link{display_density2d}}} diff --git a/man/display_faces.Rd b/man/display_faces.Rd index e7e04eab..aaa2b953 100644 --- a/man/display_faces.Rd +++ b/man/display_faces.Rd @@ -28,10 +28,9 @@ Chernoff faces. See \code{\link[TeachingDemos]{faces2}} for more details. # 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)) } \seealso{ \code{\link{animate}} for options that apply to all animations diff --git a/man/display_groupxy.Rd b/man/display_groupxy.Rd index bb873349..c6c15ddb 100644 --- a/man/display_groupxy.Rd +++ b/man/display_groupxy.Rd @@ -18,6 +18,8 @@ display_groupxy( group_by = NULL, plot_xgp = TRUE, palette = "Zissou 1", + shapeset = c(15:17, 23:25), + axislablong = FALSE, ... ) @@ -51,6 +53,11 @@ If not set, defaults to maximum distance from origin to each row of data.} \item{palette}{name of color palette for point colour, used by \code{\link{hcl.colors}}, default "Zissou 1"} +\item{shapeset}{numbers corresponding to shapes in base R points, to use for mapping +categorical variable to shapes, default=c(15:17, 23:25)} + +\item{axislablong}{text labels only for the long axes in a projection, default FALSE} + \item{...}{other arguments passed on to \code{\link{animate}} and \code{\link{display_groupxy}}} diff --git a/man/display_pca.Rd b/man/display_pca.Rd index d6a40958..bb3f75e7 100644 --- a/man/display_pca.Rd +++ b/man/display_pca.Rd @@ -16,6 +16,7 @@ display_pca( edges = NULL, edges.col = "black", palette = "Zissou 1", + axislablong = FALSE, ... ) @@ -46,6 +47,8 @@ principal components. This is required.} \item{palette}{name of color palette for point colour, used by \code{\link{hcl.colors}}, default "Zissou 1"} +\item{axislablong}{text labels only for the long axes in a projection, default FALSE} + \item{...}{other arguments passed on to \code{\link{animate}} and \code{\link{display_slice}}} diff --git a/man/display_sage.Rd b/man/display_sage.Rd index 66202f94..7a37b7d0 100644 --- a/man/display_sage.Rd +++ b/man/display_sage.Rd @@ -13,6 +13,7 @@ display_sage( gam = 1, R = NULL, palette = "Zissou 1", + axislablong = FALSE, ... ) @@ -35,6 +36,8 @@ If not set, defaults to maximum distance from origin to each row of data.} \item{palette}{name of color palette for point colour, used by \code{\link{hcl.colors}}, default "Zissou 1"} +\item{axislablong}{text labels only for the long axes in a projection, default FALSE} + \item{...}{other arguments passed on to \code{\link{animate}} and \code{\link{display_sage}}} diff --git a/man/display_slice.Rd b/man/display_slice.Rd index b9574c94..9b297052 100644 --- a/man/display_slice.Rd +++ b/man/display_slice.Rd @@ -20,6 +20,7 @@ display_slice( edges = NULL, edges.col = "black", palette = "Zissou 1", + axislablong = FALSE, ... ) @@ -61,6 +62,8 @@ If NULL (default) the slice will be anchored at the data center.} \item{palette}{name of color palette for point colour, used by \code{\link{hcl.colors}}, default "Zissou 1"} +\item{axislablong}{text labels only for the long axes in a projection, default FALSE} + \item{...}{other arguments passed on to \code{\link{animate}} and \code{\link{display_slice}}} diff --git a/man/display_trails.Rd b/man/display_trails.Rd index 2670b56d..8130fc79 100644 --- a/man/display_trails.Rd +++ b/man/display_trails.Rd @@ -13,6 +13,7 @@ display_trails( pch = 20, cex = 1, past = 3, + axislablong = FALSE, ... ) @@ -37,6 +38,8 @@ If not set, defaults to maximum distance from origin to each row of data.} \item{past}{draw line between current projection and projection \code{past} steps ago} +\item{axislablong}{text labels only for the long axes in a projection, default FALSE} + \item{...}{other arguments passed on to \code{\link{animate}} and \code{\link{display_xy}}} diff --git a/man/display_xy.Rd b/man/display_xy.Rd index 11490182..fb1eecc5 100644 --- a/man/display_xy.Rd +++ b/man/display_xy.Rd @@ -16,7 +16,13 @@ display_xy( edges.col = "black", edges.width = 1, obs_labels = NULL, + ellipse = NULL, + ellc = NULL, + ellmu = NULL, + ellmarks = TRUE, palette = "Zissou 1", + shapeset = c(15:17, 23:25), + axislablong = FALSE, ... ) @@ -46,8 +52,24 @@ If not set, defaults to maximum distance from origin to each row of data.} \item{obs_labels}{vector of text labels to display} +\item{ellipse}{pxp variance-covariance matrix defining ellipse, default NULL. Useful for +comparing data with some null hypothesis} + +\item{ellc}{This can be considered the equivalent of a critical value, used to +scale the ellipse larger or smaller to capture more or fewer anomalies. Default 3.} + +\item{ellmu}{This is the centre of the ellipse corresponding to the mean of the +normal population. Default vector of 0's} + +\item{ellmarks}{mark the extreme points with red crosses, default TRUE} + \item{palette}{name of color palette for point colour, used by \code{\link{hcl.colors}}, default "Zissou 1"} +\item{shapeset}{numbers corresponding to shapes in base R points, to use for mapping +categorical variable to shapes, default=c(15:17, 23:25)} + +\item{axislablong}{text labels only for the long axes in a projection, default FALSE} + \item{...}{other arguments passed on to \code{\link{animate}} and \code{\link{display_xy}}} @@ -94,4 +116,6 @@ animate( 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])) } diff --git a/man/draw_tour_axes.Rd b/man/draw_tour_axes.Rd index 3561f676..c73aa71b 100644 --- a/man/draw_tour_axes.Rd +++ b/man/draw_tour_axes.Rd @@ -4,7 +4,17 @@ \alias{draw_tour_axes} \title{Draw tour axes on the projected data with base graphics} \usage{ -draw_tour_axes(proj, labels, limits = 1, position = "center", ...) +draw_tour_axes( + proj, + labels, + limits = 1, + position = "center", + axis.col = "grey50", + axis.lwd = 1, + axis.text.col = "grey50", + longlabels, + ... +) } \arguments{ \item{proj}{matrix of projection coefficients} @@ -18,6 +28,14 @@ projected data, default 1} \item{position}{position of the axes: center (default), bottomleft or off} +\item{axis.col}{colour of axes, default "grey50"} + +\item{axis.lwd}{linewidth of axes, default 1} + +\item{axis.text.col}{colour of axes text, default "grey50"} + +\item{longlabels}{text labels only for the long axes in a projection, default FALSE} + \item{...}{other arguments passed} } \description{ @@ -38,4 +56,5 @@ plot(flea_prj$V1, flea_prj$V2, 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) } diff --git a/man/guided_anomaly_tour.Rd b/man/guided_anomaly_tour.Rd new file mode 100644 index 00000000..4b182c51 --- /dev/null +++ b/man/guided_anomaly_tour.Rd @@ -0,0 +1,67 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/tour-guided-anomaly.r +\name{guided_anomaly_tour} +\alias{guided_anomaly_tour} +\title{A guided anomaly tour path.} +\usage{ +guided_anomaly_tour( + index_f, + d = 2, + alpha = 0.5, + cooling = 0.99, + max.tries = 25, + max.i = Inf, + ellipse, + ellc = NULL, + ellmu = NULL, + search_f = search_geodesic, + ... +) +} +\arguments{ +\item{index_f}{the section pursuit index function to optimise. The function +needs to take two arguments, the projected data, indexes of anomalies.} + +\item{d}{target dimensionality} + +\item{alpha}{the initial size of the search window, in radians} + +\item{cooling}{the amount the size of the search window should be adjusted +by after each step} + +\item{max.tries}{the maximum number of unsuccessful attempts to find +a better projection before giving up} + +\item{max.i}{the maximum index value, stop search if a larger value is found} + +\item{ellipse}{pxp variance-covariance matrix defining ellipse, default NULL. +Useful for comparing data with some hypothesized null.} + +\item{ellc}{This can be considered the equivalent of a critical value, used to +scale the ellipse larger or smaller to capture more or fewer anomalies. Default 3.} + +\item{ellmu}{This is the centre of the ellipse corresponding to the mean of the +normal population. Default vector of 0's} + +\item{search_f}{the search strategy to use} + +\item{...}{arguments sent to the search_f} +} +\description{ +The guided anomaly tour is a variation of the guided tour that is +using an ellipse to determine anomalies on which to select target planes. +} +\details{ +Usually, you will not call this function directly, but will pass it to +a method that works with tour paths like \code{\link{animate_xy}}, +\code{\link{save_history}} or \code{\link{render}}. +} +\examples{ +animate_xy(flea[, 1:6], guided_anomaly_tour(anomaly_index(), + ellipse=cov(flea[,1:6])), ellipse=cov(flea[,1:6]), axes="off") +} +\seealso{ +\code{\link{slice_index}} for an example of an index functions. +\code{\link{search_geodesic}}, \code{\link{search_better}}, + \code{\link{search_better_random}} for different search strategies +} diff --git a/man/guided_section_tour.Rd b/man/guided_section_tour.Rd index 0f1a7d59..dc72ef58 100644 --- a/man/guided_section_tour.Rd +++ b/man/guided_section_tour.Rd @@ -18,7 +18,7 @@ guided_section_tour( ) } \arguments{ -\item{index_f}{the section purusit index function to optimise. The function +\item{index_f}{the section pursuit index function to optimise. The function needs to take three arguments, the projected data, the vector of distances from the current projection plane, and the slice thickness h.} @@ -35,7 +35,7 @@ a better projection before giving up} \item{max.i}{the maximum index value, stop search if a larger value is found} \item{v_rel}{relative volume of the slice. If not set, suggested value -is caluclated and printed to the screen.} +is calculated and printed to the screen.} \item{anchor}{A vector specifying the reference point to anchor the slice. If NULL (default) the slice will be anchored at the data center.} diff --git a/man/mahal_dist.Rd b/man/mahal_dist.Rd new file mode 100644 index 00000000..7a67a42b --- /dev/null +++ b/man/mahal_dist.Rd @@ -0,0 +1,18 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/linear-algebra.r +\name{mahal_dist} +\alias{mahal_dist} +\title{Calculate the Mahalanobis distance between points and center.} +\usage{ +mahal_dist(x, vc) +} +\arguments{ +\item{x}{matrix of data} + +\item{vc}{pre-determined variance-covariance matrix} +} +\description{ +Computes the Mahalanobis distance using a provided variance-covariance +matrix of observations from 0. +} +\keyword{algebra} diff --git a/man/mapShapes.Rd b/man/mapShapes.Rd index d1df54a6..f8edd1f6 100644 --- a/man/mapShapes.Rd +++ b/man/mapShapes.Rd @@ -4,10 +4,12 @@ \alias{mapShapes} \title{Map vector of factors to pch} \usage{ -mapShapes(x) +mapShapes(x, shapeset) } \arguments{ \item{x}{vector} + +\item{shapeset}{vector of integers indicating point shapes} } \description{ Map vector of factors to pch diff --git a/man/norm_bin.Rd b/man/norm_bin.Rd index dcf0faac..390c2045 100644 --- a/man/norm_bin.Rd +++ b/man/norm_bin.Rd @@ -15,8 +15,8 @@ norm_kol(nr) \description{ Compares the similarity between the projected distribution and a normal distribution. \itemize{ -\item{norm_bin }{compares the count in 100 histogram bins} -\item{norm_kol }{compares the cdf based on the Kolmogorov–Smirnov test (KS test)} +\item norm_bin: compares the count in 100 histogram bins +\item norm_kol: compares the cdf based on the Kolmogorov–Smirnov test (KS test) } } \examples{ diff --git a/man/radial_tour.Rd b/man/radial_tour.Rd index 85874053..e0d824e7 100644 --- a/man/radial_tour.Rd +++ b/man/radial_tour.Rd @@ -23,8 +23,8 @@ a method that works with tour paths like \code{\link{animate}}, \code{\link{save_history}} or \code{\link{render}}. } \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) }