R/mapper.R

In peekxc/Mapper: Topological Data Analysis using Mapper

#' @title mapper
#'
#' @description Computes the mapper graph. Mapper is a tool for summarizing topological information from datasets and
#' maps defined on them. It takes as input a set of 'point cloud' data, a (possibly lower dimensional) map defined on the data,
#' and produces a topological summary of the data expressed through a cover equipped to the codomain of the map. For more 
#' information, see the references below. 
#'
#' @param X Either an \eqn{n x D} data matrix.
#' @param filter An \eqn{n x d} data matrix, or a function.
#' @param cover Named list of cover parameters. See details. 
#' @param distance_measure String indicating the measure in the data space. Accepts any in \link[proxy]{pr_DB}. 
#' @param clustering_algorithm Named list of clustering parameters. See details. 
#' @param return_reference Boolean whether or not to return the reference class used to construct Mapper. See \link[Mapper]{MapperRef}.
#' @details
#' \code{mapper} is a generic function that concisely parameterizes the Mapper framework into a single function definition.
#' This function serves as a convenience wrapper around the \link[Mapper]{MapperRef} R6 generator for users that prefer a single 
#' function to parameterize the construction. 
#' For finer control over the mapper construction, it's recommended to use \link[Mapper]{MapperRef} instead. 
#' If \code{return_reference} is TRUE, the \link[Mapper]{MapperRef} instance used by this function is returned. 
#' 
#' The \code{cover} must be a named list of all of the parameters needed by the cover, as is used in e.g. \link{use_cover}. 
#' 
#' The \code{clustering_algorithm} must be a named list the parameters needed to parameterize the clustering algorith, as is used in e.g. 
#' \link{use_clustering_algorithm}
#'
#' @return If \code{return_reference} is TRUE, the \code{MapperRef} object is returned, otherwise a list given by \link{exportMapper}
#'
#' @seealso \code{\link[Mapper]{MapperRef}}
#' @useDynLib Mapper
#' @import methods
#' @importFrom Rcpp sourceCpp
#'
#' @author Matt Piekenbrock, \email{matt.piekenbrock@@gmail.com}
#' @encoding UTF-8
#' @references Singh, Gurjeet, Facundo Memoli, and Gunnar E. Carlsson. "Topological methods for the analysis of high dimensional data sets and 3d object recognition." SPBG. 2007.
#' @examples
#' data("noisy_circle", package="Mapper")
#' left_pt <- noisy_circle[which.min(noisy_circle[, 1]),]
#' f_x <- matrix(apply(noisy_circle, 1, function(pt) (pt - left_pt)[1]))
#' m <- mapper(X = noisy_circle, 
#'             filter = f_x, 
#'             cover = list(cover="fixed interval", number_intervals=10L, percent_overlap=50),
#'             distance_measure = "euclidean", 
#'             clustering_algorithm = list(cl="single", threshold = 0.0))
#' @export
mapper <- function(X, filter, 
                   cover = c(cover="fixed interval", number_intervals=10L, percent_overlap=35), 
                   distance_measure = "euclidean",
                   clustering_algorithm = c(cl="single"),
                   return_reference = FALSE) {
  ## Extract the given parameters as a named list.
  # extra <- list(...)
  # getParam <- function(param, default){  ifelse(is.null(extra[[param]]), default, extra[[param]]) }

  ## Setup 
  if (!is.null(dim(X))){ X <- as.matrix(X) } ## convert to matrix
  if (!class(X) %in% c("matrix")){ stop("Mapper expects 'X' to be either a matrix-coercible data type.") }
  m <- MapperRef$new(X = X)
  
  ## Configure mapper 
  do.call(m$use_filter, list(filter=filter))
  do.call(m$use_cover, as.list(cover))
  do.call(m$use_distance_measure, list(measure=distance_measure))
  do.call(m$use_clustering_algorithm, as.list(clustering_algorithm))
  m$construct_k_skeleton(k = 1L)

  ## Convert to 'Mapper' object or, if the reference class is wanted, return that. The .summary attribute
  ## stores a useful string used for default printing characteristics of the Mapper.
  if (return_reference){
    return(m)
  } else {
    mapperoutput <- m$exportMapper()
    # if (class(mapperoutput) == "Mapper"){
    #   attr(mapperoutput, ".summary") <- c(attr(mapperoutput, ".summary"), paste0("\nCall:  ", paste0(trimws(deparse(match.call())), collapse = " "), sep = ""))
    # }
    rm(m)
    return(mapperoutput)
  }
}

#' S3 method for default printing
#' @param x Mapper object.
#' @param ... unused. 
#' @export
print.Mapper <- function(x, ...){
  writeLines(attr(x, ".summary"))
}

# Empty environment to allow passing parameters to dashboard
.dash_env <- new.env(parent = emptyenv())