R/class_definitions.R In SimoneHermann/BaPreStoPro: Bayesian Prediction of Stochastic Processes

#' S4 class of model informations for the jump diffusion process
#' @description Informations of model
#' \eqn{dY_t = b(\phi,t,Y_t)dt + s(\gamma^2,t,Y_t)dW_t + h(\theta,t,Y_t)dN_t} with
#' \eqn{N_t\sim Pois(\Lambda(t, \xi))}.
#' @slot theta parameter \eqn{\theta}
#' @slot phi parameter \eqn{\phi}
#' @slot gamma2 parameter \eqn{\gamma^2}
#' @slot xi parameter \eqn{\xi}
#' @slot b.fun function \eqn{b(\phi,t,y)}
#' @slot s.fun function \eqn{s(\gamma^2,t,y)}
#' @slot h.fun function \eqn{b(\theta,t,y)}
#' @slot Lambda function \eqn{\Lambda(t,\xi)}
#' @slot priorDensity list of prior density functions, default is a non-informative approach
#' @slot start list of starting values for the Metropolis within Gibbs sampler
#' @examples
#' parameter <- list(phi = 0.01, theta = 0.1, gamma2 = 0.01, xi = c(2, 0.2))
#' b.fun <- function(phi, t, y) phi * y
#' s.fun <- function(gamma2, t, y) sqrt(gamma2) * y
#' h.fun <- function(theta, t, y) theta * y
#' Lambda <- function(t, xi) (t / xi[2])^xi[1]
#' priorDensity <- list(
#'   phi = function(phi) 1,
#'   theta = function(theta) dnorm(theta, 0.1, 0.001),
#'   gamma2 = function(gamma2) dgamma(1/gamma2, 3, 0.01*2),
#'   xi = function(xi) dgamma(xi, c(2, 0.2), 1)
#' )
#' start <- parameter
#' model <- set.to.class("jumpDiffusion", parameter, start = start,
#'   b.fun = b.fun, s.fun = s.fun, h.fun = h.fun, Lambda = Lambda,
#'   priorDensity = priorDensity)

setClass(Class = "jumpDiffusion", representation = representation(theta = "numeric", phi = "numeric", gamma2 = "numeric", xi = "numeric",
b.fun = "function", s.fun = "function", h.fun = "function",
Lambda = "function", priorDensity = "list", start = "list"))

#' S4 class of model informations for a special jump diffusion process, called Merton model
#' @description Informations of model
#' \eqn{dY_t = \phi Y_t dt + \gamma^2 Y_t dW_t + \theta Y_tdN_t} with
#' \eqn{N_t\sim Pois(\Lambda(t, \xi))}. The explicit solution of the SDE is given by
#'   \eqn{Y_t = y_0 \exp( \phi t - \gamma^2/2 t+\gamma W_t + \log(1+\theta) N_t)}.
#' @slot thetaT parameter \eqn{\widetilde{\theta}=\log(1+\theta)}
#' @slot phi parameter \eqn{\phi}
#' @slot gamma2 parameter \eqn{\gamma^2}
#' @slot xi parameter \eqn{\xi}
#' @slot Lambda function \eqn{\Lambda(t,\xi)}
#' @slot prior list of prior parameters for \eqn{\phi, \widetilde{\theta}, \gamma^2}
#' @slot priorDensity list of prior density function for \eqn{\xi}
#' @slot start list of starting values for the Metropolis within Gibbs sampler
#' @examples
#' parameter <- list(phi = 0.01, thetaT = 0.1, gamma2 = 0.01, xi = c(2, 0.2))
#' Lambda <- function(t, xi) (t / xi[2])^xi[1]
#' # prior density for xi:
#' priorDensity <- function(xi) dgamma(xi, c(2, 0.2), 1)
#' # prior parameter for phi (normal), thetaT (normal) and gamma2 (inverse gamma):
#' prior <- list(m.phi = parameter$phi, v.phi = parameter$phi, m.thetaT = parameter$thetaT, #' v.thetaT = parameter$thetaT, alpha.gamma = 3, beta.gamma = parameter$gamma2*2) #' start <- parameter #' model <- set.to.class("Merton", parameter, prior, start, Lambda = Lambda, #' priorDensity = priorDensity) #' summary(class.to.list(model)) #' # default: #' model <- set.to.class("Merton", parameter, Lambda = Lambda) #' setClass(Class = "Merton", representation = representation(thetaT = "numeric", phi = "numeric", gamma2 = "numeric", xi = "numeric", Lambda = "function", prior = "list", start = "list", priorDensity = "function")) #' S4 class of model informations for diffusion process #' @description Informations of model #' \eqn{dY_t = b(\phi,t,Y_t)dt + \gamma \widetilde{s}(t,Y_t)dW_t}. #' @slot phi parameter \eqn{\phi} #' @slot gamma2 parameter \eqn{\gamma^2} #' @slot b.fun function \eqn{b(\phi,t,y)} #' @slot sT.fun function \eqn{\widetilde{s}(t,y)} #' @slot prior list of prior parameters #' @slot start list of starting values for the Metropolis within Gibbs sampler #' @examples #' parameter <- list(phi = 0.1, gamma2 = 0.01) #' b.fun <- function(phi, t, y) phi * y #' sT.fun <- function(t, y) y #' start <- parameter #' prior <- list(m.phi = parameter$phi, v.phi = parameter$phi^2, #' alpha.gamma = 3, beta.gamma = 2*parameter$gamma2)
#' model <- set.to.class("Diffusion", parameter, prior, start,
#'   b.fun = b.fun, sT.fun = sT.fun)

setClass(Class = "Diffusion", representation = representation(phi = "numeric", gamma2 = "numeric",
b.fun = "function", sT.fun = "function", prior = "list", start = "list"))
#' S4 class of model informations for hierarchical (mixed) diffusion process model
#' @description Informations of model
#' \eqn{dY_t = b(\phi_j,t,Y_t)dt + \gamma \widetilde{s}(t,Y_t)dW_t, \phi_j\sim N(\mu, \Omega), Y_{t_0}=y_0(\phi, t_0)}.
#' @slot phi parameter \eqn{\phi}
#' @slot mu parameter \eqn{\mu}
#' @slot Omega parameter \eqn{\Omega}
#' @slot gamma2 parameter \eqn{\gamma^2}
#' @slot y0.fun function \eqn{y_0(\phi, t)}
#' @slot b.fun function \eqn{b(\phi,t,y)}
#' @slot sT.fun function \eqn{\widetilde{s}(t,y)}
#' @slot prior list of prior parameters
#' @slot start list of starting values for the Metropolis within Gibbs sampler
#' @examples
#' mu <- c(2, 1); Omega <- c(1, 0.04)
#' phi <- sapply(1:2, function(i) rnorm(21, mu[i], sqrt(Omega[i])))
#' parameter <- list(phi = phi, mu = mu, Omega = Omega, gamma2 = 0.01)
#' b.fun <- function(phi, t, y) phi[1] * y
#' sT.fun <- function(t, y) y
#' y0.fun <- function(phi, t) phi[2]
#' start <- parameter
#' prior <- list(m.mu = parameter$mu, v.mu = parameter$mu^2,
#'    alpha.omega = rep(3, length(parameter$mu)), beta.omega = parameter$Omega*2,
#'    alpha.gamma = 3, beta.gamma = parameter$gamma2*2) #' model <- set.to.class("mixedDiffusion", parameter, prior, start, #' b.fun = b.fun, sT.fun = sT.fun, y0.fun = y0.fun) setClass(Class = "mixedDiffusion", representation = representation(phi = "matrix", mu = "numeric", Omega = "numeric", gamma2 = "numeric", y0.fun = "function", b.fun = "function", sT.fun = "function", prior = "list", start = "list")) #' S4 class of model informations for hidden diffusion process #' @description Informations of model #' \eqn{Z_i = Y_{t_i} + \epsilon_i, dY_t = b(\phi,t,Y_t)dt + \gamma \widetilde{s}(t,Y_t)dW_t, #' \epsilon_i\sim N(0,\sigma^2), Y_{t_0}=y_0(\phi, t_0)}. #' @slot phi parameter \eqn{\phi} #' @slot gamma2 parameter \eqn{\gamma^2} #' @slot sigma2 parameter \eqn{\sigma^2} #' @slot y0.fun function \eqn{y_0(\phi, t)} #' @slot b.fun function \eqn{b(\phi,t,y)} #' @slot sT.fun function \eqn{\widetilde{s}(t,y)} #' @slot prior list of prior parameters #' @slot start list of starting values for the Metropolis within Gibbs sampler #' @examples #' parameter <- list(phi = c(2, 1), gamma2 = 0.1, sigma2 = 0.1) #' b.fun <- function(phi, t, y) phi[1] * y #' sT.fun <- function(t, y) y #' y0.fun <- function(phi, t) phi[2] #' start <- parameter #' prior <- list(m.phi = parameter$phi, v.phi = parameter$phi^2, alpha.gamma = 3, #' beta.gamma = parameter$gamma2*2, alpha.sigma=3, beta.sigma=parameter$sigma2*2) #' model <- set.to.class("hiddenDiffusion", parameter, prior, start, #' b.fun = b.fun, sT.fun = sT.fun, y0.fun = y0.fun) setClass(Class = "hiddenDiffusion", representation = representation(phi = "numeric", gamma2 = "numeric", sigma2 = "numeric", b.fun = "function", sT.fun = "function", y0.fun = "function", prior = "list", start = "list")) #' S4 class of model informations for hierarchical (mixed) hidden diffusion process #' @description Informations of model #' \eqn{Z_{ij} = Y_{t_{ij}} + \epsilon_{ij}, dY_t = b(\phi_j,t,Y_t)dt + \gamma \widetilde{s}(t,Y_t)dW_t, \phi_j\sim N(\mu, \Omega), #' Y_{t_0}=y_0(\phi, t_0), \epsilon_{ij}\sim N(0,\sigma^2)}. #' @slot phi parameter \eqn{\phi} #' @slot mu parameter \eqn{\mu} #' @slot Omega parameter \eqn{\Omega} #' @slot gamma2 parameter \eqn{\gamma^2} #' @slot sigma2 parameter \eqn{\sigma^2} #' @slot y0.fun function \eqn{y_0(\phi, t)} #' @slot b.fun function \eqn{b(\phi,t,y)} #' @slot sT.fun function \eqn{\widetilde{s}(t,y)} #' @slot prior list of prior parameters #' @slot start list of starting values for the Metropolis within Gibbs sampler #' @examples #' mu <- c(2, 1); Omega <- c(1, 0.04) #' phi <- sapply(1:2, function(i) rnorm(21, mu[i], sqrt(Omega[i]))) #' parameter <- list(phi = phi, mu = mu, Omega = Omega, gamma2 = 0.1, sigma2 = 0.1) #' b.fun <- function(phi, t, y) phi[1] * y #' sT.fun <- function(t, y) y #' y0.fun <- function(phi, t) phi[2] #' start <- parameter #' prior <- list(m.mu = parameter$mu, v.mu = parameter$mu^2, #' alpha.omega = rep(3, length(parameter$mu)), beta.omega = parameter$Omega*2, #' alpha.gamma = 3, beta.gamma = parameter$gamma2*2,
#'    alpha.sigma = 3, beta.sigma = parameter$sigma2*2) #' model <- set.to.class("hiddenmixedDiffusion", parameter, prior, start, #' b.fun = b.fun, sT.fun = sT.fun, y0.fun = y0.fun) setClass(Class = "hiddenmixedDiffusion", representation = representation(phi = "matrix", mu = "numeric", Omega = "numeric", gamma2 = "numeric", sigma2 = "numeric", b.fun = "function", sT.fun = "function", y0.fun = "function", prior = "list", start = "list")) #' S4 class of model informations for the jump regression model #' @description Informations of model #' \eqn{y_i = f(t_i, N_{t_i}, \theta) + \epsilon_i} with #' \eqn{N_t\sim Pois(\Lambda(t, \xi)), \epsilon_i\sim N(0,\gamma^2\widetilde{s}(t))}. #' @slot theta parameter \eqn{\theta} #' @slot gamma2 parameter \eqn{\gamma^2} #' @slot xi parameter \eqn{\xi} #' @slot fun function \eqn{f(t, N, \theta)} #' @slot sT.fun function \eqn{\widetilde{s}(t)} #' @slot Lambda function \eqn{\Lambda(t,\xi)} #' @slot prior list of prior parameters #' @slot start list of starting values for the Metropolis within Gibbs sampler #' @examples #' parameter <- list(theta = c(3, 1), gamma2 = 0.1, xi = c(2, 0.2)) #' fun <- function(t, N, theta) theta[1]*t + theta[2]*N #' sT.fun <- function(t) t #' Lambda <- function(t, xi) (t / xi[2])^xi[1] #' prior <- list(m.theta = parameter$theta, v.theta = parameter$theta^2, #' alpha.gamma = 3, beta.gamma = parameter$gamma2*2)
#' start <- parameter
#' model <- set.to.class("jumpRegression", parameter, prior, start = start,
#'   fun = fun, sT.fun = sT.fun, Lambda = Lambda)

setClass(Class = "jumpRegression", representation = representation(theta = "numeric", gamma2 = "numeric", xi = "numeric", fun = "function",
Lambda = "function", sT.fun = "function", prior = "list", start = "list"))

#' S4 class of model informations for non-homogeneous Poisson process
#' @description Informations of NHPP with cumulative intensity function
#' \eqn{\Lambda(t, \xi)}.
#' @slot xi parameter \eqn{\xi}
#' @slot Lambda function \eqn{\Lambda(t,\xi)}
#' @slot priorDensity prior density function for \eqn{\xi}
#' @slot start list of starting values for the Metropolis within Gibbs sampler
#' @examples
#' parameter <- list(xi = c(2, 0.2))
#' Lambda <- function(t, xi) (t / xi[2])^xi[1]
#' priorDensity <- function(xi) dgamma(xi, c(2, 0.2), 1)
#' start <- parameter
#' model <- set.to.class("NHPP", parameter, start = start, Lambda = Lambda,
#'    priorDensity = priorDensity)

setClass(Class = "NHPP", representation = representation(xi = "numeric", Lambda = "function", priorDensity = "function", start = "numeric"))

#' S4 class of model informations for the regression model
#' @description Informations of model
#'   \eqn{y_i = f(\phi, t_i) + \epsilon_i, \epsilon_i\sim N(0,\gamma^2\widetilde{s}(t_i))}.
#' @slot phi parameter \eqn{\phi}
#' @slot gamma2 parameter \eqn{\gamma^2}
#' @slot fun function \eqn{f(\phi, t)}
#' @slot sT.fun function \eqn{\widetilde{s}(t)}
#' @slot prior list of prior parameters
#' @slot start list of starting values for the Metropolis within Gibbs sampler
#' @examples
#' parameter <- list(phi = c(3, 1), gamma2 = 0.1)
#' fun <- function(phi, t) phi[1] + phi[2]*t
#' sT.fun <- function(t) t
#' prior <- list(m.phi = parameter$phi, v.phi = parameter$phi^2,
#'    alpha.gamma = 3, beta.gamma = 2*parameter$gamma2) #' start <- parameter #' model <- set.to.class("Regression", parameter, prior, start, fun = fun, sT.fun = sT.fun) setClass(Class = "Regression", representation = representation(phi = "numeric", gamma2 = "numeric", fun = "function", sT.fun = "function", prior = "list", start = "list")) #' S4 class of model informations for the hierarchical (mixed) regression model #' @description Informations of model #' \eqn{y_{ij} = f(\phi_j, t_{ij}) + \epsilon_{ij}, \phi_j\sim N(\mu, \Omega), #' \epsilon_{ij}\sim N(0,\gamma^2\widetilde{s}(t_{ij}))}. #' @slot phi parameter \eqn{\phi} #' @slot mu parameter \eqn{\mu} #' @slot Omega parameter \eqn{\Omega} #' @slot gamma2 parameter \eqn{\gamma^2} #' @slot fun function \eqn{f(\phi, t)} #' @slot sT.fun function \eqn{\widetilde{s}(t)} #' @slot prior list of prior parameters #' @slot start list of starting values for the Metropolis within Gibbs sampler #' @examples #' mu <- c(2, 1); Omega <- c(1, 0.04) #' phi <- sapply(1:2, function(i) rnorm(21, mu[i], sqrt(Omega[i]))) #' parameter <- list(phi = phi, mu = mu, Omega = Omega, gamma2 = 0.01) #' fun <- function(phi, t) phi[1] + phi[2]*t #' sT.fun <- function(t) t #' prior <- list(m.mu = parameter$mu, v.mu = parameter$mu^2, #' alpha.omega = rep(3, length(parameter$mu)), beta.omega = parameter$Omega*2, #' alpha.gamma = 3, beta.gamma = parameter$gamma2*2)
#' start <- parameter
#' model <- set.to.class("mixedRegression", parameter, prior, start, fun = fun, sT.fun = sT.fun)

setClass(Class = "mixedRegression", representation = representation(phi = "matrix", mu = "numeric", Omega = "numeric", gamma2 = "numeric",
fun = "function", sT.fun = "function", prior = "list", start = "list"))

####################
# estimation classes
####################

setClass(Class = "est.jumpDiffusion", representation = representation(theta = "numeric", phi = "numeric", gamma2 = "numeric", xi = "matrix",
model = "list", N.est = "matrix", t = "numeric",
Y = "numeric", N = "numeric",
burnIn = "numeric", thinning = "numeric"))

setClass(Class = "est.Merton", representation = representation(thetaT = "numeric", phi = "numeric", gamma2 = "numeric", xi = "matrix",
model = "list", N.est = "matrix", t = "numeric",
Y = "numeric", N = "numeric",
burnIn = "numeric", thinning = "numeric"))

setClass(Class = "est.Diffusion", representation = representation(phi = "matrix", gamma2 = "numeric",
model = "list", t = "numeric", Y = "numeric",
burnIn = "numeric", thinning = "numeric"))
# Y, t as list ?!?
setClass(Class = "est.mixedDiffusion", representation = representation(phi = "list", mu = "matrix", Omega = "matrix", gamma2 = "numeric",
model = "list", t = "numeric", Y = "matrix", t.list = "list", Y.list = "list",
burnIn = "numeric", thinning = "numeric"))

setClass(Class = "est.hiddenDiffusion", representation = representation(phi = "matrix", gamma2 = "numeric", sigma2 = "numeric", Y.est = "matrix",
model = "list", t = "numeric", Z = "numeric",
burnIn = "numeric", thinning = "numeric"))

setClass(Class = "est.hiddenmixedDiffusion", representation = representation(phi = "list", mu = "matrix", Omega = "matrix", gamma2 = "numeric",
sigma2 = "numeric", Y.est = "list",
model = "list", t = "numeric", Z = "matrix", t.list = "list", Z.list = "list",
burnIn = "numeric", thinning = "numeric"))

setClass(Class = "est.jumpRegression", representation = representation(theta = "matrix", gamma2 = "numeric", xi = "matrix", N.est = "matrix",
model = "list", t = "numeric", Y = "numeric", N = "numeric",
burnIn = "numeric", thinning = "numeric"))

setClass(Class = "est.NHPP", representation = representation(xi = "matrix", model = "list", N = "numeric", t = "numeric", jumpTimes = "numeric",
burnIn = "numeric", thinning = "numeric"))

setClass(Class = "est.Regression", representation = representation(phi = "matrix", gamma2 = "numeric",
model = "list", t = "numeric", Y = "numeric",
burnIn = "numeric", thinning = "numeric"))

setClass(Class = "est.mixedRegression", representation = representation(phi = "list", mu = "matrix", Omega = "matrix", gamma2 = "numeric",
model = "list", t = "numeric", Y = "matrix", t.list = "list", Y.list = "list",
burnIn = "numeric", thinning = "numeric"))

SimoneHermann/BaPreStoPro documentation built on May 10, 2017, 1:42 p.m.