R/interactive_tour.R

In lionfish: Interactive 'tourr' Using 'python'

#' @title R Wrapper for 'interactive_tour' Function Written in 'python'
#' @description
#' Launches the lionfish GUI and at minimum requires the data do be loaded and
#' the plot_objects. The other parameters are optional. For technical reasons
#' the parameters half_range, n_plot_cols, n_subsets, color_scale, label_size
#' and display_size cannot be adjusted from within the GUI. The GUI has to be
#' closed and relaunched (possibly with load_interactive_tour) if you want to
#' change them. Please visit https://mmedl94.github.io/lionfish/index.html for a
#' detailed description of the GUI and its features.
#'
#' @param data the dataset you want to investigate
#' @param plot_objects a named list of objects you want to be displayed. Each entry requires a definition of
#' the type of display and a specification of what should be plotted.
#' @param feature_names names of the features of the dataset
#' @param half_range factor that influences the scaling of the displayed tour plots.
#' Small values lead to more spread out datapoints (that might not fit the plotting area),
#' while large values lead to the data being more compact. If not provided a good estimate
#' will be calculated and used.
#' @param n_plot_cols specifies the number of columns of the grid of the final display.
#' @param preselection a vector that specifies in which subset each datapoint should be put initially.
#' @param preselection_names a vector that specifies the names of the preselection subsets
#' @param n_subsets the total number of available subsets.
#' @param display_size rough size of each subplot in inches
#' @param hover_cutoff number of features at which the switch from intransparent
#' to transparent labels that can be hovered over to make them intransparent occurs
#' @param label_size size of the labels of the feature names of 1d and 2d tours
#' @param axes_blendout_threshhold initial value of the threshold for blending
#' out projection axes with a smaller length
#' @param color_scale a viridis/matplotlib colormap to define the color scheme of the subgroups
#' @param color_scale_heatmap a viridis/matplotlib colormap to define the color scheme of the heatmap
#'
#' @export
#'
#' @return opens the interactive GUI
#'
#' @examples
#' library(tourr)
#' data("flea", package = "tourr")
#' data <- flea[1:6]
#' clusters <- as.numeric(flea$species)
#' flea_subspecies <- unique(flea$species)
#' feature_names <- colnames(data)
#'
#' guided_tour_history <- tourr::save_history(data,
#'   tour_path = tourr::guided_tour(holes())
#' )
#' grand_tour_history_1d <- tourr::save_history(data,
#'   tour_path = tourr::grand_tour(d = 1)
#' )
#'
#' half_range <- max(sqrt(rowSums(data^2)))
#'
#' obj1 <- list(type = "2d_tour", obj = guided_tour_history)
#' obj2 <- list(type = "1d_tour", obj = grand_tour_history_1d)
#' obj3 <- list(type = "scatter", obj = c("tars1", "tars2"))
#' obj4 <- list(type = "hist", obj = "head")
#'
#' if (check_venv()){
#' init_env(env_name = "r-lionfish", virtual_env = "virtual_env")
#' } else if (check_conda_env()){
#' init_env(env_name = "r-lionfish", virtual_env = "anaconda")
#' }
#'
#' if (interactive()){
#' interactive_tour(
#'   data = data,
#'   plot_objects = list(obj1, obj2, obj3, obj4),
#'   feature_names = feature_names,
#'   half_range = half_range,
#'   n_plot_cols = 2,
#'   preselection = clusters,
#'   preselection_names = flea_subspecies,
#'   n_subsets = 5,
#'   display_size = 5
#' )
#' }
interactive_tour <- function(data, plot_objects, feature_names = NULL, half_range = NULL,
                             n_plot_cols = 2, preselection = FALSE,
                             preselection_names = FALSE, n_subsets = 3, display_size = 5,
                             hover_cutoff = 10, label_size = 15, color_scale = "default",
                             color_scale_heatmap="default", axes_blendout_threshhold = 1) {
  pytourr_dir <- find.package("lionfish", lib.loc = NULL, quiet = TRUE)

  if (dir.exists(file.path(pytourr_dir, "/inst"))) {
    pytourr_dir <- base::paste(pytourr_dir, "/inst/python", sep = "")
  } else {
    pytourr_dir <- base::paste(pytourr_dir, "/python", sep = "")
  }
  req_py_func <- "/interactive_tour.py"

  if (is.null(feature_names)) {
    feature_names <- paste("feature", 1:ncol(data))
  }

  # check the data type of the data and transform factors to numerics and normalize them
  if (is.data.frame(data)) {
    data[] <- lapply(data, function(x) {
      if (is.factor(x)) {
        x <- as.numeric(x)
        (x - min(x)) / (max(x) - min(x))
      } else {
        x
      }
    })
  } else if (data.table::is.data.table(data)) {
    data <- data[, lapply(data.table::.SD, function(x) {
      if (is.factor(x)) {
        x <- as.numeric(x)
        (x - min(x)) / (max(x) - min(x))
      } else {
        x
      }
    })]
  }

  func_loc <- base::paste(pytourr_dir, req_py_func, sep = "")
  reticulate::source_python(func_loc)
  reticulate::py$interactive_tour(
    data, plot_objects, feature_names, half_range,
    n_plot_cols, preselection,
    preselection_names, n_subsets, display_size,
    hover_cutoff, label_size, color_scale,
    color_scale_heatmap,
    axes_blendout_threshhold
  )
}