R/add-grf-function.R

In mathiasisaksen/GRFics: Efficient generation of noise functions from approximate Gaussian random fields

#' Add function to GRF object
#'
#' Generates a function from the GRF object specified as a parameter, and adds it to the object.
#'
#' @details The object \code{chol.object}, which is needed for computing the function, is computed and added to \code{grf.object}
#' the first time that \code{add.grf.function} is run.
#'
#' @param grf.object A GRF object generated by \code{\link{generate.grf.object}}.
#' @param seed Optional, the seed used for generating the function.
#'
#' @return The GRF object with the function added to the \code{functions} list.
#'
#' @examples
#' library(GRFics)
#' # Prepare GRF object
#' grf.object = generate.grf.object(0, 1, 0, 1, 100, 100)
#' # Add two functions to object
#' grf.object = add.grf.function(grf.object, seed = 0)
#' grf.object = add.grf.function(grf.object, seed = 1)
#' # Extract data frames
#' function.1.df = get.function.df(grf.object, function.number = 1)
#' function.2.df = get.function.df(grf.object, function.number = 2)
#' # Create combined data frame for plotting
#' combined.df = rbind(function.1.df, function.2.df)
#' combined.df$facet.var = rep(1:2, each = nrow(function.1.df))
#' # Plot functions side by side
#' library(ggplot2)
#' ggplot()+
#'   geom_raster(data = combined.df, aes(x = x, y = y, fill = z))+
#'   coord_fixed()+
#'   facet_grid(cols = vars(facet.var))
#'
#' @export
#' @author Mathias Isaksen \email{mathiasleanderi@@gmail.com}
add.grf.function = function(grf.object, function.name = NULL, seed = NULL) {
  if (is.null(grf.object$model.components$chol.object)) {
    grf.object$model.components$chol.object = permuted.cholesky.decomp(grf.object$model.components$Q)
  }

  function.name = ifelse(is.null(function.name), as.character(length(grf.object$functions)+1), function.name)
  if (!is.character(function.name)) {
    function.name = as.character(function.name)
  }

  if (is.null(grf.object$functions)) {
    seed = ifelse(is.null(seed), grf.object$initial.seed, seed)
  }

  new.function = generate.gmrf.realization(chol.object = grf.object$model.components$chol.object, seed = seed)
  grf.object$functions[[function.name]] = new.function
  if (is.null(grf.object$ecdf.functions)) {
    grf.object$ecdf.functions = list()
  }
  grf.object$ecdf.functions[[function.name]] = ecdf(new.function)
  return(grf.object)
}