R/autoplot.metaMDS.R

In ggvegan: 'ggplot2' Plots for the 'vegan' Package

#' @title ggplot-based plot for objects of class `"metaMDS"`
#'
#' @description
#' Produces a multi-layer ggplot object representing the output of
#' objects produced by [vegan::metaMDS()].
#'
#' @details
#' TODO
#'
#' @param object an object of class `"metaMDS"`, the result of a call
#' to [vegan::metaMDS()].
#' @param ... Additional arguments passed to `\link{fortify.metaMDS}`.
#'
#' @inheritParams autoplot.cca
#' @return Returns a ggplot object.
#'
#' @author Gavin L. Simpson
#'
#' @export
#'
#' @importFrom grid arrow unit
#' @importFrom ggplot2 autoplot ggplot geom_point geom_text labs coord_fixed
#'   aes
#'
#' @examples
#'
#' library("vegan")
#'
#' data(dune)
#'
#' sol <- metaMDS(dune)
#' autoplot(sol)
`autoplot.metaMDS` <- function(
  object,
  geom = c("point", "text"),
  layers = c("species", "sites"),
  legend.position = "right",
  title = NULL,
  subtitle = NULL,
  caption = NULL,
  ylab,
  xlab,
  ...
) {
  obj <- fortify(object, layers = layers, ...)
  obj <- obj[obj$score %in% layers, ]
  ## sort out x, y aesthetics
  vars <- get_dimension_names(obj)
  ## skeleton layer
  plt <- ggplot()
  geom <- match.arg(geom)
  point <- TRUE
  if (isTRUE(all.equal(geom, "text"))) {
    point <- FALSE
  }
  if (point) {
    plt <- plt +
      geom_point(
        data = obj,
        mapping = aes(
          x = .data[[vars[1]]],
          y = .data[[vars[2]]],
          shape = .data[["score"]],
          colour = .data[["score"]]
        )
      )
  } else {
    plt <- plt +
      geom_text(
        data = obj,
        mapping = aes(
          x = .data[[vars[1]]],
          y = .data[[vars[2]]],
          label = .data[["label"]],
          colour = .data[["score"]]
        )
      )
  }
  if (missing(xlab)) {
    xlab <- vars[1]
  }
  if (missing(ylab)) {
    ylab <- vars[2]
  }
  plt <- plt +
    labs(
      x = toupper(xlab),
      y = toupper(ylab),
      title = title,
      subtitle = subtitle,
      caption = caption
    )
  ## add equal scaling
  plt <- plt + coord_fixed(ratio = 1)
  ## do we want a legend
  plt <- plt + theme(legend.position = legend.position)
  plt
}