R/utils.R

In SpatialDDLS: Deconvolution of Spatial Transcriptomics Data Based on Neural Networks

#' @importFrom ggplot2 theme_bw
#' @importFrom reticulate conda_binary py_available py_module_available conda_install
#' @importFrom utils compareVersion
#' @importFrom tensorflow install_tensorflow
#' @importFrom stats terms
NULL

#' Getter function for the cell composition matrix
#'
#' Getter function for the cell composition matrix. This function allows to
#' access to the cell composition matrix of simulated mixed transcriptional
#' profiles.
#'
#' @param object \code{\linkS4class{SpatialDDLS}} object with
#'   \code{prob.cell.types} slot.
#' @param type.data Subset of data to return: \code{train} or \code{test}.
#'
#' @return Cell type proportion matrix.
#'
#' @export
#'
#' @seealso \code{\link{genMixedCellProp}}
#'
#'   
getProbMatrix <- function(object, type.data) {
  if (!is(object, "SpatialDDLS")) {
    stop("Provided object is not a SpatialDDLS object")
  } else if (!any(type.data == c("train", "test"))) {
    stop("'type.data' argument must be 'train' or 'test'")
  } else if (is.null(prob.cell.types(object))) {
    stop("'prob.cell.types' slot is empty")
  } else if (is.null(prob.cell.types(object, type.data))) {
    stop(paste("No", type.data, "data in 'prob.cell.types' slot"))
  } 
  return(prob.cell.types(object, type.data)@prob.matrix)
}

#' Show distribution plots of the cell proportions generated by
#' \code{\link{genMixedCellProp}}
#'
#' Show distribution plots of the cell proportions generated by the
#' \code{\link{genMixedCellProp}} function.
#'
#' These frequencies will determine the proportion of different cell types used
#' during the simulation of mixed transcriptional profiles. Proportions
#' generated by each method (see \code{?\link{genMixedCellProp}}) can be
#' visualized in three ways: box plots, violin plots, and lines plots. You can
#' also plot the probabilities based on the number of different cell types
#' present in the samples by setting \code{type.plot = 'nCellTypes'}.
#'
#' @param object \code{\linkS4class{SpatialDDLS}} object with
#'   \code{prob.cell.types} slot with \code{plot} slot.
#' @param type.data Subset of data to show: \code{train} or \code{test}.
#' @param set Integer determining which of the 6 different subsets to display.
#' @param type.plot Character determining which type of visualization to
#'   display. It can be \code{'boxplot'}, \code{'violinplot'},
#'   \code{'linesplot'} or \code{'ncelltypes'}. See Description for more
#'   information.
#'
#' @return A ggplot object.
#'
#' @export
#'
#' @seealso \code{\link{genMixedCellProp}}
#'
#' @examples
#' set.seed(123)
#' sce <- SingleCellExperiment::SingleCellExperiment(
#'   assays = list(
#'     counts = matrix(
#'       rpois(100, lambda = 5), nrow = 40, ncol = 30,
#'       dimnames = list(paste0("Gene", seq(40)), paste0("RHC", seq(30)))
#'     )
#'   ),
#'   colData = data.frame(
#'     Cell_ID = paste0("RHC", seq(30)),
#'     Cell_Type = sample(x = paste0("CellType", seq(4)), size = 30,
#'                        replace = TRUE)
#'   ),
#'   rowData = data.frame(
#'     Gene_ID = paste0("Gene", seq(40))
#'   )
#' )
#'
#' SDDLS <- createSpatialDDLSobject(
#'   sc.data = sce,
#'   sc.cell.ID.column = "Cell_ID",
#'   sc.gene.ID.column = "Gene_ID",
#'   project = "Simul_example",
#'   sc.filt.genes.cluster = FALSE
#' )
#' SDDLS <- genMixedCellProp(
#'   object = SDDLS,
#'   cell.ID.column = "Cell_ID",
#'   cell.type.column = "Cell_Type",
#'   num.sim.spots = 10, 
#'   train.freq.cells = 2/3,
#'   train.freq.spots = 2/3,
#'   verbose = TRUE
#' )
#' showProbPlot(
#'    SDDLS,
#'    type.data = "train",
#'    set = 1,
#'    type.plot = "boxplot"
#'  )
#'  
showProbPlot <- function(
  object,
  type.data,
  set,
  type.plot = "boxplot"
) {
  if (!is(object, "SpatialDDLS")) {
    stop("Provided object is not a SpatialDDLS object")
  } else if (is.null(object@prob.cell.types) || 
             (length(object@prob.cell.types) == 0)) {
    stop("'prob.cell.types' slot is empty")
  } else if (!any(type.data == c("train", "test"))) {
    stop("'type.data' argument must be 'train' or 'test'")
  } else if (length(object@prob.cell.types[[type.data]]) == 0) {
    stop(paste0("ProbMatrixCellTypes object does not have plots (", type.data, " data)"))
  } else if (set < 1 || set > 3) {
    stop("'set' argument must be an integer between 1 and 3")
  } else if (!any(type.plot == c("violinplot", "boxplot", "linesplot", "ncelltypes"))) {
    stop("'type.plot' argument must be one of the next options: 'violinplot', ", 
         "'boxplot', 'linesplot' or 'ncelltypes'")
  }
  return(prob.cell.types(object, type.data)@plots[[set]][[type.plot]])
}

#' Prepare \code{\linkS4class{SpatialDDLS}} object to be saved as an RDA file
#'
#' This function prepares a \code{\linkS4class{SpatialDDLS}} object to be saved
#' as an RDA file when contains a \code{\linkS4class{DeconvDLModel}} object with
#' a trained DNN model.
#'
#' Since \pkg{keras} models cannot be saved natively as R objects, this function
#' saves the structure of the model as a JSON-like character object and its
#' weights as a list. This allows for the retrieval of the model and making
#' predictions. It is important to note that the state of the optimizer is not
#' saved, only the model's architecture and weights. To save the entire model,
#' please see the \code{\link{saveTrainedModelAsH5}} and
#' \code{\link{loadTrainedModelFromH5}} functions.
#'
#' It is also possible to save a \code{\linkS4class{SpatialDDLS}} object as an
#' RDS file with the \code{saveRDS} function without any preparation.
#'
#' @param object \code{\linkS4class{SpatialDDLS}} object with a
#'   \code{trained.data} slot containing a \code{\linkS4class{DeconvDLModel}}
#'   object with a trained DNN model.
#'
#' @return A \code{\linkS4class{SpatialDDLS}} or
#'   \code{\linkS4class{DeconvDLModel}} object with its trained keras model
#'   transformed from a \code{keras.engine.sequential.Sequential} class into a
#'   \code{list} with its architecture as a JSON-like character object, and its
#'   weights as a list.
#'
#' @export
#'
#' @seealso \code{\link{saveRDS}} \code{\link{saveTrainedModelAsH5}}
#'   
preparingToSave <- function(
  object
) {
  # check if python dependencies are covered
  .checkPythonDependencies(alert = "error")
  if (!is(object, "SpatialDDLS") && !is(object, "DeconvDLModel")) {
    stop("Provided object is not a SpatialDDLS object")
  }
  if (is.null(trained.model(object))) {
    stop("Provided object has not a DeconvDLModel object. It is not necessary ",
            "to prepare this object to save it to disk")
  } else if (length(trained.model(object)@model) == 0) {
    stop("Provided object has not a trained DNN model. It is not necessary ",
            "to prepare the object to save it to disk")
  }
  if (!is(trained.model(object)@model, "list")) 
    trained.model(object) <- .saveModelToJSON(trained.model(object))
  return(object)
}

# core of barplots of deconvolution results
.barPlot <- function(
  data,
  colors,
  color.line = NA,
  x.label = "Bulk samples",
  rm.x.text = FALSE,
  title = "Results of deconvolution",
  legend.title = "Cell types",
  angle = 90,
  theme = NULL
) {
  df.res <- reshape2::melt(data * 100, value.name = "Proportion")
  p <- ggplot(
    data = df.res, aes(
      x = .data[["Var1"]], y = .data[["Proportion"]], fill = .data[["Var2"]]
    )
  ) + geom_bar(stat = "identity", color = color.line) + theme
  if (!missing(colors) && !is.null(colors)) {
    if (length(colors) < length(unique(df.res$Var2)))
      stop("Number of provided colors is not enough for the number of cell types")
  } else {
    colors <- default.colors()
  }
  p <- p + scale_fill_manual(values = colors) + SpatialDDLSTheme()
  if (is.null(x.label)) {
    p <- p + theme(axis.title.x = element_blank())
  } else {
    p <- p + xlab(x.label)
  }
  p <- p + ggtitle(title) + ggplot2::labs(fill = legend.title) + theme(
    plot.title = element_text(face = "bold", hjust = 0.5),
    axis.title = element_text(size = 12),
    axis.text.x = element_text(angle = angle, hjust = 1, vjust = 0.5),
    legend.title = element_text(face = "bold")
  )
  if (rm.x.text) {
    p <- p + theme(axis.ticks.x = element_blank(),
                   axis.text.x = element_blank())
  }
  return(p)
}

################################################################################
####################### Utils functions related to DNN #########################
################################################################################

#' Save a trained \code{\linkS4class{SpatialDDLS}} deep neural network model to
#' disk as an HDF5 file
#'
#' Save a trained \code{\linkS4class{SpatialDDLS}} deep neural network model to
#' disk as an HDF5 file. Note that this function does not save the
#' \code{\linkS4class{DeconvDLModel}} object, only the trained \pkg{keras}
#' model. This is the alternative to the \code{\link{saveRDS}} and
#' \code{\link{preparingToSave}} functions if you want to keep the state of the
#' optimizer.
#'
#' @param object \code{\linkS4class{SpatialDDLS}} object with
#'   \code{trained.model} slot.
#' @param file.path Valid file path where to save the model to.
#' @param overwrite Overwrite file if it already exists.
#'
#' @return No return value, saves a \pkg{keras} DNN trained model as HDF5 file
#'   on disk.
#'
#' @export
#'
#' @seealso \code{\link{trainDeconvModel}} \code{\link{loadTrainedModelFromH5}}
#'   
saveTrainedModelAsH5 <- function(
  object,
  file.path,
  overwrite = FALSE
) {
  # check if python dependencies are covered
  .checkPythonDependencies(alert = "error")
  if (!is(object, "SpatialDDLS")) {
    stop("Provided object is not a SpatialDDLS object")
  } else if (is.null(trained.model(object))) {
    stop("'trained.model' slot is empty")
  } else if (length(trained.model(object)@model) == 0) {
    stop("There is no model to save on disk. First, train a model with ",
         "the 'trainSpatialDDLSModel' function")
  }
  if (file.exists(file.path)) {
    if (overwrite) {
      message(paste(file.path, "file already exists. Since 'overwrite' argument is",
                    "TRUE, it will be overwritten"))
    } else {
      stop(paste(file.path, "file already exists"))
    }
  }
  if (is(trained.model(object)@model, "list")) {
    warning(paste(
      "Trained model is not a keras object, but a R list with",
      "architecture of network and weights. The R object will be",
      "compiled and saved as HDF5 file, but the optimizer state",
      "will not be saved\n\n"
    ))
    model <- .loadModelFromJSON(trained.model(object))
    model <- model(model)
  } else {
    model <- trained.model(object)@model
  }
  tryCatch(
    expr = {
      save_model_hdf5(
        object = model, filepath = file.path,
        overwrite = overwrite, include_optimizer = TRUE
      )
    }, 
    error = function(cond) {
      message(paste("\nProblem during saving", file.path))
      stop(cond)
    }
  )
}

#' Load from an HDF5 file a trained deep neural network model into a
#' \code{\linkS4class{SpatialDDLS}} object
#'
#' Load from an HDF5 file a trained deep neural network model into a
#' \code{\linkS4class{SpatialDDLS}} object. Note that HDF5 file must be a valid
#' trained model (\pkg{keras} object).
#'
#' @param object \code{\linkS4class{SpatialDDLS}} object with
#'   \code{trained.model} slot.
#' @param file.path Valid file path where the model are stored.
#' @param reset.slot Deletes \code{trained.slot} if it already exists. A new
#'   \code{\link{DeconvDLModel}} object will be formed, but will not contain
#'   other slots (\code{FALSE} by default).
#'
#' @return \code{\linkS4class{SpatialDDLS}} object with \code{trained.model}
#'   slot with the new \pkg{keras} DNN model incorporated.
#'
#' @export
#'
#' @seealso \code{\link{trainDeconvModel}} \code{\link{saveTrainedModelAsH5}}
#'   
loadTrainedModelFromH5 <- function(
  object,
  file.path,
  reset.slot = FALSE
) {
  # check if python dependencies are covered
  .checkPythonDependencies(alert = "error")
  if (!is(object, "SpatialDDLS")) {
    stop("Provided object is not a SpatialDDLS object")
  } else if (!file.exists(file.path)) {
    stop(paste(file.path, "file does not exist. Please, provide a valid file path"))
  }
  if (!is.null(trained.model(object))) {
    slot.exists <- TRUE
    message("'trained.model' slot is not empty:")
    if (reset.slot) {
      message("  'reset.slot' is TRUE, 'trained.model' slot will be restarted")
    } else {
      message("  'reset.slot' is FALSE, only 'model' slot of DeconvDLModel ",
              "object will be overwritten")
    }
  } else {
    slot.exists <- FALSE
  }
  tryCatch(
    expr = {
      loaded.model <- load_model_hdf5(filepath = file.path, compile = FALSE)
    }, 
    error = function(cond) {
      message(paste("\n", file.path, "file provided is not a valid keras model:"))
      stop(cond)
    }
  )
  if (!slot.exists) {
    model <- new(Class = "DeconvDLModel",
                 model = loaded.model)
  } else {
    if (reset.slot) {
      model <- new(Class = "DeconvDLModel",
                   model = loaded.model)
    } else {
      model(object@trained.model) <- loaded.model
      return(object)
    }
  }
  trained.model(object) <- model
  return(object)
}

#' Plot training history of a trained SpatialDDLS deep neural network model
#'
#' Plot training history of a trained SpatialDDLS deep neural network model.
#'
#' @param object \code{\linkS4class{SpatialDDLS}} object with a
#'   \code{trained.model} slot.
#' @param title Title of plot.
#' @param metrics Metrics to be plotted. If \code{NULL} (by default), all
#'   metrics available in the \code{\linkS4class{DeconvDLModel}} object will be
#'   plotted.
#'
#' @return A ggplot object with the progression of the selected metrics during
#'   training.
#'
#' @export
#'
#' @seealso \code{\link{trainDeconvModel}}
#'   
plotTrainingHistory <- function(
  object,
  title = "History of metrics during training",
  metrics = NULL
) {
  # check if python dependencies are covered
  .checkPythonDependencies(alert = "error")
  if (!is(object, "SpatialDDLS")) {
    stop("Provided object is not of SpatialDDLS class")
  } else if (is.null(trained.model(object))) {
    stop("'trained.model' slot is empty")
  } else if (is.null(trained.model(object)@training.history)) {
    stop("There is no training history in provided object")
  }
  if (!is.null(metrics)) {
    if (!all(metrics %in% names(trained.model(object)@training.history$metrics))) {
      stop("None of the given metrics are in the provided object")
    }
  }
  plot(
    trained.model(object)@training.history,
    metrics = metrics, method = "ggplot2"
  ) + ggtitle(title) + SpatialDDLSTheme()
}

# custom ggplot2 theme
SpatialDDLSTheme <- function() {
  digitalTheme <- ggplot2::theme_bw() + theme(
    plot.title = element_text(face = "bold", hjust = 0.5),
    legend.title = element_text(face = "bold")
  )
}

#' Bar plot of deconvoluted cell type proportions
#'
#' Bar plot of deconvoluted cell type proportions.
#'
#' @param data \code{\linkS4class{SpatialDDLS}} object with the
#'   \code{deconv.spots} slot containing predicted cell type proportions.
#' @param colors Vector of colors to be used.
#' @param set Type of simplification performed during deconvolution. It can
#'   be \code{simpli.set} or \code{simpli.maj} (\code{NULL} by default).
#'   
#' @param prediction Set of predicted cell proportions to be plotted. It can be 
#'   \code{"Regularized"}, \code{"Intrinsic"} or \code{"Extrinsic"}. 
#' @param color.line Color of the border bars.
#' @param x.label Label of x-axis.
#' @param rm.x.text Logical value indicating whether to remove x-axis ticks
#'   (name of samples).
#' @param title Title of the plot.
#' @param legend.title Title of the legend plot.
#' @param angle Angle of text ticks.
#' @param index.st Name or index of the element wanted to be shown in the
#'   \code{deconv.spots} slot.
#' @param theme \pkg{ggplot2} theme.
#'
#' @return A ggplot object with the provided cell proportions represented as a
#'   bar plot.
#'
#' @export
#'
#' @rdname barPlotCellTypes
#'
#' @seealso \code{\link{deconvSpatialDDLS}}
#'   
barPlotCellTypes <- function(
  data,
  colors = NULL,
  set = NULL,
  prediction = "Regularized",
  color.line = NA,
  x.label = "Spots",
  rm.x.text = FALSE,
  title = "Results of deconvolution",
  legend.title = "Cell types",
  angle = 90,
  theme = NULL,
  index.st = NULL
) {
  if (is.null(deconv.spots(data))) {
    stop("There are no results in SpatialDDLS object. Please see ?deconvSpatialDDLS")
  } else if (is.null(index.st)) {
    message("'index.st' not provided. Setting index.st <- 1")
    index.st <- 1
  } else if (!any(index.st %in% names(deconv.spots(data))) &&
             !any(index.st %in% seq_along(deconv.spots(data)))) {
    stop("Provided 'index.st' does not exist")
  }
  if (!is.null(set) && !is.na(set)) {
    if (!any(names(deconv.spots(data)[[index.st]]) %in% c("simpli.set", "simpli.majority"))) {
      stop("No simplified results available")
    } else {
      if (set != "simpli.set" && set != "simpli.majority") {
        stop("set argument must be one of the following options: ",
             "'simpli.set' or 'simpli.majority'")
      } else if (!any(set == names(deconv.spots(data)[[index.st]]))) {
        stop(paste(set, "data are not present in DeconvDLModel object"))
      }
      res <- deconv.spots(data)[[index.st]][[set]]
    }
  } else {
    if (
      is(deconv.spots(data)[[index.st]], "list") & 
      any(names(deconv.spots(data)[[index.st]]) %in% c("simpli.set", "simpli.majority"))
    ) {
      res <- deconv.spots(data)[[index.st]][[1]]
    } else {
      res <- deconv.spots(data)[[index.st]]
    }
  }
  
  if (!any(prediction %in% c("Regularized", "Intrinsic", "Extrinsic"))) {
    stop("prediction can only be one of the following options: 'Regularized', 'Intrinsic', 'Extrinsic'")
  } else if (is.null(set) | missing(set)) {
    res <- res[[prediction]]
  }
  if (is.null(colnames(res))) {
    stop(
      "'data' must have colnames (corresponding cell types). Please run deconvSpatialDDLS"
    )
  }
  return(
    .barPlot(
      data = res,
      colors = colors,
      color.line = color.line,
      x.label = x.label,
      rm.x.text = rm.x.text,
      title = title,
      legend.title = legend.title,
      angle = angle,
      theme = theme
    )
  )
}

################################################################################
############################# Python dependencies ##############################
################################################################################

.isConda <- function() {
  conda <- tryCatch(
    reticulate::conda_binary("auto"), error = function(e) NULL
  )
  !is.null(conda)
}

.isPython <- function() {
  tryCatch(
    expr = reticulate::py_available(initialize = TRUE), 
    error = function(e) FALSE
  )
}

.isTensorFlow <- function() {
  tfAvailable <- reticulate::py_module_available("tensorflow")
  if (tfAvailable) {
    tfVersion <- tensorflow::tf$`__version__`
    tfAvailable <- utils::compareVersion("2.2", tfVersion) <= 0
  }
  return(tfAvailable)
}

# alert parameter: c("none", "error", "warn", "message", "startup")
.checkPythonDependencies <- function(
  alert = "error"
) {
  # turn off reticulate autoconfigure
  ac_flag <- Sys.getenv("RETICULATE_AUTOCONFIGURE")
  on.exit(Sys.setenv(RETICULATE_AUTOCONFIGURE = ac_flag))
  Sys.setenv(RETICULATE_AUTOCONFIGURE = FALSE)
  dependencies <- c(python = .isPython(), tf = .isTensorFlow())
  if (!all(dependencies)) {
    messageT <- c(
      "There is no a Python interpreter with all the SpatialDDLS \
        dependencies covered available. Please, see ?installTFpython"
    )
    warningT <- c(
      "There is no a Python interpreter with all the SpatialDDLS \
        dependencies covered available. Please, see ?installTFpython"
    )
    errorT <- c(
      "There is no a Python interpreter with all the SpatialDDLS \
        dependencies covered available. Please, see ?installTFpython"
    )
    switch(
      alert,
      error = stop(errorT, call. = FALSE),
      warn = warning(warningT, call. = FALSE),
      message = message(messageT),
      startup = packageStartupMessage(messageT),
      none = NULL
    )
  }
  return(invisible(all(dependencies)))
}

#' Install Python dependencies for SpatialDDLS
#'
#' This function facilitates the installation of the required Python
#' dependencies for the \pkg{SpatialDDLS} R package, as it requires a Python 
#' interpreter with the TensorFlow Python library and its dependencies. 
#' 
#' This function is intended to simplify the installation process for 
#' \pkg{SpatialDDLS} by automatically installing Miniconda and creating a new 
#' environment named SpatialDDLS-env with all \pkg{SpatialDDLS}' dependencies 
#' covered. For users who wish to use a different Python or conda environment, 
#' see the \code{tensorflow::use_condaenv} function for more information.
#'
#' @param conda Path to a conda executable. Using \code{"auto"} (by default)
#'   allows \pkg{reticulate} to automatically find an appropriate conda binary.
#' @param python.version Python version to be installed in the environment 
#'   (\code{"3.8"} by default). We recommend keeping this version as it has 
#'   been tested to be compatible with tensorflow 2.6.
#' @param tensorflow.version Tensorflow version to be installed in the 
#'   environment (\code{"2.6"} by default). 
#' @param install.conda Boolean indicating if installing miniconda automatically
#'   by using \pkg{reticulate}. If \code{TRUE}, \code{conda} argument is
#'   ignored. \code{FALSE} by default.
#' @param miniconda.path If \code{install.conda} is \code{TRUE}, you can set the
#'   path where miniconda will be installed. If \code{NULL}, conda will find
#'   automatically the proper place.
#'
#' @return No return value, called for side effects: installation of conda
#'   environment with a Python interpreter and Tensorflow
#'
#' @export
#'
#' @examples
#' \dontrun{
#' notesInstallation <- installTFpython(
#'   conda = "auto", install.conda = TRUE
#' )
#' }
#' 
installTFpython <- function(
  conda = "auto",
  python.version = "3.8",
  tensorflow.version = "2.6",
  install.conda = FALSE,
  miniconda.path = NULL
) {
  if ((!.isConda())) {
    if (!install.conda) {
      stop("No miniconda detected, but 'install.conda' is FALSE. Please, set ", 
           "'install.conda = TRUE' to install miniconda." )
    }
    message("=== No miniconda detected, installing through the reticulate R package")
    if (is.null(miniconda.path)) {
      miniconda.path <- reticulate::miniconda_path()
    }
    status1 <- tryCatch(
      reticulate::install_miniconda(path = miniconda.path), 
      error = function(e) {
        return(TRUE)
      }
    )
    if (isTRUE(status1)) {
      stop(
        "Error during the installation. Please see the website of the ",
        "package and/or the vignettes for more details",
        call. = FALSE
      )
    }
  }
  dirConda <- reticulate::conda_binary("auto")
  message("\n=== Creating SpatialDDLS-env environment")
  
  ## custom versions 
  if (python.version != "3.8" | tensorflow.version != "2.6") {
    warning(
      "Please, be sure the selected Python and TensorFlow versions are ", 
      "compatible. Otherwise, miniconda will raise an error", 
      call. = FALSE, immediate. = TRUE
    )
  }
  
  status2 <- tryCatch(
    reticulate::conda_create(
      envname = "SpatialDDLS-env", 
      packages = paste0("python=", python.version)
    ), 
    error = function(e) {
      return(TRUE)
    }
  )
  if (isTRUE(status2)) {
    stop(
      "Error during the installation. Please see the website of the ",
      "package and/or the vignettes for more details",
      call. = FALSE
    )
  }
  message("\n=== Installing tensorflow in SpatialDDLS-env environment")
  status3 <- tryCatch(
    tensorflow::install_tensorflow(
      version = paste0(tensorflow.version, "-cpu"),
      method = "conda", 
      conda = dirConda, 
      envname = "SpatialDDLS-env"
    ), 
    error = function(e) {
      return(TRUE)
    }
  )
  if (isTRUE(status3)) {
    stop(
      "Error during the installation. Please see the website of the ",
      "package and/or the vignettes for more details",
      call. = FALSE
    )
  }
  message("Installation complete!")
  message(c("Restart R and load SpatialDDLS. If you find any problem, \
         see ?tensorflow::use_condaenv"))
}

# functions from the Matrix.utils R package
.aggregate.Matrix.sparse <- function(
    x, groupings = NULL, form = NULL, fun = 'sum', ...
) {
  if(!is(x, 'Matrix')) x <- Matrix::Matrix(as.matrix(x), sparse = TRUE)
  if(fun == 'count') x <- x != 0
  groupings2 <- groupings
  if(!is(groupings2, 'data.frame'))
    groupings2 <- as(groupings2, 'data.frame')
  groupings2 <- data.frame(lapply(groupings2, as.factor))
  groupings2 <- data.frame(interaction(groupings2, sep = '_'))
  colnames(groupings2)<-'A'
  if(is.null(form)) form <- as.formula('~0+.')
  form <- as.formula(form)
  mapping <- .aggregate.Matrix.cast(groupings2, form)
  colnames(mapping) <- substring(colnames(mapping), 2)
  result <- Matrix::t(mapping) %*% x
  if(fun == 'mean')
    result@x <- result@x/(.aggregate.Matrix.sparse(x, groupings2, fun = 'count'))@x
  attr(result,'crosswalk') <- grr::extract(groupings, match(rownames(result), groupings2$A))
  return(result)
}

.aggregate.Matrix.cast <- function(
    data,
    formula,
    fun.aggregate = 'sum',
    value.var = NULL,
    as.factors = FALSE, 
    factor.nas = TRUE,
    drop.unused.levels = TRUE
) {
  values <- 1
  if(!is.null(value.var))
    values <- data[,value.var]
  alltms <- stats::terms(formula, data = data)
  response <- rownames(attr(alltms, 'factors'))[attr(alltms, 'response')]
  tm <- attr(alltms,"term.labels")
  interactionsIndex <- grep(':', tm)
  interactions <- tm[interactionsIndex]
  simple <- setdiff(tm, interactions)
  i2 <- strsplit(interactions, ':')
  newterms <- unlist(lapply(i2, function (x) paste("paste(", paste(x, collapse=','), ",", "sep='_'", ")")))
  newterms <- c(simple, newterms)
  newformula <- as.formula(paste('~0+', paste(newterms, collapse = '+')))
  allvars <- all.vars(alltms)
  data <- data[,c(allvars),drop = FALSE]
  if(as.factors) data <- data.frame(lapply(data, as.factor))
  characters <- unlist(lapply(data, is.character))
  data[,characters] <- lapply(data[, characters, drop = FALSE], as.factor)
  factors <- unlist(lapply(data, is.factor))
  #Prevents errors with 1 or fewer distinct levels
  data[,factors] <- lapply(
    data[, factors, drop = FALSE],
    function (x) {
      if (factor.nas)
        if (any(is.na(x))) {
          levels(x) <- c(levels(x), 'NA')
          x[is.na(x)] <- 'NA'
        }
      if (drop.unused.levels)
        if (nlevels(x) != length(stats::na.omit(unique(x))))
          x <- factor(as.character(x))
      y <- stats::contrasts(x, contrasts = FALSE, sparse = TRUE)
      attr(x, 'contrasts') <- y
      return(x)
    }
  )
  #Allows NAs to pass
  attr(data,'na.action') <- stats::na.pass
  result <- Matrix::sparse.model.matrix(newformula, data, drop.unused.levels = FALSE, row.names = FALSE)
  brokenNames <- grep('paste(', colnames(result), fixed = TRUE)
  colnames(result)[brokenNames] <- lapply(
    colnames(result)[brokenNames], 
    function (x) {
      x <- gsub('paste(', replacement = '', x = x, fixed = TRUE) 
      x <- gsub(pattern = ', ', replacement = '_', x = x, fixed=TRUE) 
      x <- gsub(pattern = '_sep = \"_\")', replacement = '', x = x, fixed = TRUE)
      return(x)
    }
  )
  
  result <- result * values
  if(isTRUE(response>0)) {
    responses = all.vars(stats::terms(as.formula(paste(response,'~0'))))
    result <- .aggregate.Matrix.sparse(result, data[, responses, drop = FALSE], fun = fun.aggregate)
  }
  return(result)
}