R/sample_path_sbm.R

In shill1729/FeynmanKacSolver: Feynman-Kac PDE solver for Ito diffusions and processes

#' Simulate a sample path of spatial Brownian motion starting from a given point
#'
#' @param t length of time to simulate over
#' @param IC the initial values of the xyz coordinates.
#' @param parameters list of parameters for jump-dynamics
#' @param jumps a list of objects defining the jump-size distribution, can be NULL for purely continuous models, see details.
#' @param n number of time sub-intervals in the discretization
#'
#' @description {Non exported Wrapper to \code{sample_path_em} to directly simulate a sample path of spatial Brownian motion without having to specify the trivial
#' coefficient functions. This function should not be called directly but rather through \code{sample_path} with \code{continuous.model} set to \code{"sbm"}.}
#' @details { The list \code{jumps} should contain
#' \itemize{
#' \item \code{distr} the name of the distribution of the jump-sizes e.g. "norm", "unif", "kou"
#' \item \code{param} named list of parameters for the distribution matching the input in \code{rdistr} for a given "distr".
#' }}
#' @return data.frame containing \code{t} (time) and the three spatial coordinates \code{x}, \code{y} and \code{z}.
sample_path_sbm <- function(t, IC = NULL, parameters = NULL, jumps = NULL, n = 10000)
{
  if(is.null(parameters) || is.null(parameters$lambda))
  {
    lambda <- function(x, t) 0
  } else
  {
    lambda <- parameters$lambda
  }
  if(is.null(IC))
  {
    IC <- list(x0 = 0, y0 = 0, z0 = 0)
  } else{
    if(is.null(IC$x0))
    {
      stop("Need to pass initial value 'x0' in 'IC' list for 'sbm'")
    } else if(is.null(IC$y0))
    {
      stop("Need to pass initial value 'y0' in 'IC' list for 'sbm'")
    } else if(is.null(IC$z0))
    {
      stop("Need to pass initial value 'z0' in 'IC' list for 'sbm'")
    }
  }
  coeff <- list(f.mu = function(X, t) 0,
                f.vo = function(x, t) 1,
                f.lambda = function(x, t) lambda(x, t))
  # Simulate two independent BMs
  X <- euler_maruyama(t = t, coeff = coeff, IC = list(x0 = IC$x0), jumps = jumps, exponential = FALSE, n = n)
  Y <- euler_maruyama(t = t, coeff = coeff, IC = list(x0 = IC$y0), jumps = jumps, exponential = FALSE, n = n)
  Z <- euler_maruyama(t = t, coeff = coeff, IC = list(x0 = IC$z0), jumps = jumps, exponential = FALSE, n = n)
  B <- data.frame(t = X$t, x = X$X, y = Y$X, z = Z$X)
  return(B)
}