default lda_ord retention params to true - fixes #65

NEWS.md

@@ -68,6 +68,11 @@ A new 'depth' statistical transformation estimates depth across a grid and is pa
 Aided by element standardization, the classic `density_2d` statistical transformation and geometric construction are adapted to biplots.
 Currently, source code generation does not respect fixed parameters passed to `layer()` by the `stat_*()` and `geom_*()` shortcuts; as a consequence, `contour = TRUE` must be manually passed to `geom_*_density_2d()`.
 
+## miscellany
+
+Previously, `lda_ord()` mimicked `MASS::lda()` in defaulting the retrieval parameters `ret.x` and `ret.grouping` to `FALSE`.
+Because they are so important to analysis and especially to biplots, they now default to `TRUE`.
+
 # ordr 0.1.1
 
 ## `linewidth` aesthetic (breaking change)

R/biplot.r

@@ -121,7 +121,7 @@ ggbiplot <- function(
       c("eigen", "eigen_ord", "svd_ord", "prcomp", "princomp")
     # only allow pythagorean metrics and linear pre-procedures
     # FIXME: Allow pythagorean ordinations with non-linear pre-procedures?
-    if (! ord_class %in% linear_trans_classes) {
+    if (! any(ord_class %in% linear_trans_classes)) {
       warning("Predictive biplots are only implemented for linear methods ",
               "(ED, SVD, PCA).")
     } else {

R/fun-lda.r

@@ -1,7 +1,7 @@
 #' @title Augmented implementation of linear discriminant analysis
 #'
-#' @description This function replicates [MASS::lda()] with options to retain
-#'   elements useful to the [tbl_ord] class and biplot calculations.
+#' @description This function replicates [MASS::lda()] with options and defaults
+#'   to retain elements useful to the [tbl_ord] class and biplot calculations.
 #'
 #' @details
 #'
@@ -38,6 +38,11 @@
 #' their variable values after centering and sphering (Greenacre, 2013).
 #' 
 
+#' Finally, in contrast to [MASS::lda()], `lda_ord()` defaults both `ret.x` and
+#' `ret.grouping` to `TRUE`, so that these elements can be used to compute and
+#' annotate case scores as [supplementary][supplementation] elements.
+#' 
+
 #' @template ref-gardner2005
 #' @template ref-greenacre2010
 #' @template ref-venables2003
@@ -138,7 +143,7 @@ lda_ord.matrix <- function(x, grouping, ..., subset, na.action)
 lda_ord.default <- function(x, grouping, prior = proportions, tol = 1.0e-4,
                             method = c("moment", "mle", "mve", "t"),
                             CV = FALSE, nu = 5, ...,
-                            ret.x = FALSE, ret.grouping = FALSE,
+                            ret.x = TRUE, ret.grouping = TRUE,
                             axes.scale = "unstandardized")
 {
   if(is.null(dim(x))) stop("'x' is not a matrix")
@@ -305,7 +310,8 @@ lda_ord.default <- function(x, grouping, prior = proportions, tol = 1.0e-4,
 #' @rdname lda-ord
 #' @export
 predict.lda_ord <- function(object, newdata, prior = object$prior, dimen,
-                            method = c("plug-in", "predictive", "debiased"), ...)
+                            method = c("plug-in", "predictive", "debiased"),
+                            ...)
 {
   if(!inherits(object, "lda")) stop("object not of class \"lda\"")
   if(!is.null(Terms <- object$terms)) { # formula fit
@@ -328,7 +334,8 @@ predict.lda_ord <- function(object, newdata, prior = object$prior, dimen,
         newdata <-
           eval.parent(parse(text = paste(deparse(object$call$x,
                                                  backtick = TRUE),
-                                         "[", deparse(sub, backtick = TRUE),",]")))
+                                         "[", deparse(sub, backtick = TRUE),
+                                         ",]")))
       else newdata <- eval.parent(object$call$x)
       if(!is.null(nas <- object$call$na.action))
         newdata <- eval(call(nas, newdata))
@@ -353,12 +360,14 @@ predict.lda_ord <- function(object, newdata, prior = object$prior, dimen,
   x <- scale(x, center = means, scale = FALSE) %*% scaling
   dm <- scale(object$means, center = means, scale = FALSE) %*% scaling
   method <- match.arg(method)
-  dimen <- if(missing(dimen)) length(object$svd) else min(dimen, length(object$svd))
+  dimen <- 
+    if(missing(dimen)) length(object$svd) else min(dimen, length(object$svd))
   N <- object$N
   if(method == "plug-in") {
     dm <- dm[, 1L:dimen, drop = FALSE]
     dist <- matrix(0.5 * rowSums(dm^2) - log(prior), nrow(x),
-                   length(prior), byrow = TRUE) - x[, 1L:dimen, drop=FALSE] %*% t(dm)
+                   length(prior), byrow = TRUE) -
+      x[, 1L:dimen, drop=FALSE] %*% t(dm)
     dist <- exp( -(dist - apply(dist, 1L, min, na.rm=TRUE)))
   } else if (method == "debiased") {
     dm <- dm[, 1L:dimen, drop=FALSE]

inst/examples/ex-ggbiplot-prediction-iris.r

@@ -3,7 +3,6 @@ iris_pca <- ordinate(iris, cols = 1:4, prcomp, scale = TRUE)
 
 # row-principal predictive biplot
 iris_pca %>%
-  augment_ord() %>%
   ggbiplot(axis.type = "predictive") +
   theme_bw() +
   scale_color_brewer(type = "qual", palette = 2) +
@@ -13,7 +12,6 @@ iris_pca %>%
 
 # with two calibrated axes
 iris_pca %>%
-  augment_ord() %>%
   ggbiplot(axis.type = "predictive") +
   theme_bw() +
   scale_color_brewer(type = "qual", palette = 2) +

inst/examples/ex-ordinate.r

@@ -16,7 +16,7 @@ ordinate(haireye, MASS::corresp, cols = everything())
 ordinate(swiss, model = factanal, factors = 2L, scores = "Bartlett")
 
 # LDA of iris data
-ordinate(iris, ~ lda_ord(.[, 1:4], .[, 5], ret.x = TRUE))
+ordinate(iris, ~ lda_ord(.[, 1:4], .[, 5]))
 
 # CCA of savings data
 ordinate(

tests/testthat/test-ordr-ldaord.r

@@ -1,6 +1,6 @@
-fit_lda_ord1 <- lda_ord(iris[, 1:4], iris[, 5])
+fit_lda_ord1 <- lda_ord(iris[, 1:4], iris[, 5], ret.x = FALSE)
 fit_lda_ord2 <- lda_ord(Species ~ ., iris)
-fit_lda_ord3 <- lda_ord(iris[, 1:4], iris[, 5], ret.x = TRUE)
+fit_lda_ord3 <- lda_ord(iris[, 1:4], iris[, 5])
 
 test_that("'lda' accessors have consistent dimensions", {
   expect_equal(ncol(get_rows(fit_lda_ord1)), ncol(get_cols(fit_lda_ord1)))