[Yuima-commits] r410 - in pkg/yuima: . R man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Sun Mar 6 17:19:32 CET 2016
Author: lorenzo
Date: 2016-03-06 17:19:31 +0100 (Sun, 06 Mar 2016)
New Revision: 410
Added:
pkg/yuima/man/Integral.sde.rd
pkg/yuima/man/Integrand.rd
pkg/yuima/man/param.Integral.rd
pkg/yuima/man/setIntegral.Rd
pkg/yuima/man/variable.Integral.rd
pkg/yuima/man/yuima.Integral-class.rd
Modified:
pkg/yuima/NAMESPACE
pkg/yuima/R/FunctionAndOperators.R
pkg/yuima/R/NewClasses.R
pkg/yuima/R/qmle.R
pkg/yuima/R/simulateForMapsIntegralAndOperator.R
pkg/yuima/man/yuima.Output-class.Rd
Log:
Added Method and Class for Integral of SDE
Modified: pkg/yuima/NAMESPACE
===================================================================
--- pkg/yuima/NAMESPACE 2016-03-02 14:06:09 UTC (rev 409)
+++ pkg/yuima/NAMESPACE 2016-03-06 16:19:31 UTC (rev 410)
@@ -74,7 +74,12 @@
"yuima.Output",
"info.Output",
"param.Output",
-"yuima.multimodel"
+"yuima.multimodel",
+"param.Integral",
+"variable.Integral",
+"Integrand",
+"Integral.sde",
+"yuima.Integral"
)
exportMethods(
@@ -122,6 +127,7 @@
export(setCogarch)
export(setMap)
export(setMultiModel)
+export(setIntegral)
export(dim)
export(length)
Modified: pkg/yuima/R/FunctionAndOperators.R
===================================================================
--- pkg/yuima/R/FunctionAndOperators.R 2016-03-02 14:06:09 UTC (rev 409)
+++ pkg/yuima/R/FunctionAndOperators.R 2016-03-06 16:19:31 UTC (rev 410)
@@ -197,99 +197,112 @@
}
-# setIntegral <- function(yuima, integrand, var.dx,
-# lower.var, upper.var, out.var = "", nrow =1 ,ncol=1,
-# type = "Integral"){
-# if(missing(yuima)){
-# yuima.stop("yuima object is missing.")
-# }
-# if(missing(integrand)){
-# yuima.stop("Integrand function is missing")
-# }
-# if(missing(var.dx)){
-# yuima.stop("dx object is missing.")
-# }
+setIntegral <- function(yuima, integrand, var.dx,
+ lower.var, upper.var, out.var = "", nrow =1 ,ncol=1){
+ type <- "Integral"
+ res <- aux.setIntegral(yuima = yuima, integrand = integrand,
+ var.dx = var.dx, lower.var = lower.var, upper.var = upper.var,
+ out.var = out.var, nrow = nrow , ncol = ncol,
+ type = type)
+
+ return(res)
+
+# param <- list(allparam=unique(allparam), common=common,
+# IntegrandParam = paramIntegrand)
#
-# resFunc<-constFunc(func=integrand, nrow, ncol)
-# Integrand <- resFunc$func
-# dimension <- resFunc$dimens
-#
-# modDum <- ExtYuimaMod(yuima)
-# mod <- modDum$mod
-# yuima <- modDum$yuima
-# paramIntegrand <- NULL
-# ddd <- prod(dimension)
-# IntegrandList <- as.list(character(length=ddd))
-# Integrand <- as.character(Integrand)
-#
-# for(i in c(1:ddd)){
-# IntegrandList[[i]]<-parse(text=Integrand[i])
-# paramIntegrand<-c(paramIntegrand,all.vars(IntegrandList[[i]]))
-# }
-#
-# paramIntegrand<-unique(paramIntegrand)
-# common<-mod at parameter@common
-#
-# Cond<-(mod at parameter@all %in% paramIntegrand)
-# common <- c(common,mod at parameter@all[Cond])
-# # solve variable
-# Cond <- (paramIntegrand %in% mod at solve.variable)
-# if(sum(Cond)==0){
-# yuima.warn("Integrand fuction does not depend on solve.variable")
-# }
-#
-# paramIntegrand <- paramIntegrand[!Cond]
-# # time variable
-# Cond <- (paramIntegrand %in% mod at time.variable)
-# paramIntegrand <- paramIntegrand[!Cond]
-# # upper.var
-# if((upper.var == mod at time.variable)||(lower.var == mod at time.variable)){
-# yuima.stop("upper.var or lower.var must be different from time.variable")
-# }
-#
-# Cond <- (paramIntegrand %in% upper.var)
-# paramIntegrand <- paramIntegrand[!Cond]
-#
-# Cond <- (paramIntegrand %in% lower.var)
-# paramIntegrand <- paramIntegrand[!Cond]
-#
-# allparam <- c(mod at parameter@all, unique(paramIntegrand))
-#
-# if(type == "Integral"){
-# cond1 <-c(var.dx %in% c(mod at solve.variable, mod at time.variable))
-# if(sum(cond1)!=dimension[2]){
-# yuima.stop("var.dx must be contains only components of solve variable or time variable")
-# }
-# }
-# my.param.Integral <- new("param.Integral",
-# allparam = unique(allparam),
-# common = common,
-# Integrandparam = paramIntegrand)
-# my.variable.Integral <- new("variable.Integral",
-# var.dx = var.dx,
-# lower.var = lower.var,
-# upper.var = upper.var,
-# out.var = out.var,
-# var.time = yuima at model@time.variable)
-# my.integrand <- new("Integrand",
-# IntegrandList=IntegrandList,
-# dimIntegrand = dimension)
-#
-# my.Integral<-new("Integral.sde",
-# param.Integral = my.param.Integral,
-# variable.Integral = my.variable.Integral,
-# Integrand = my.integrand)
-# res<-new("yuima.Integral",Integral=my.Integral, yuima=yuima)
-# return(res)
-#
-# # param <- list(allparam=unique(allparam), common=common,
-# # IntegrandParam = paramIntegrand)
-# #
-# # return(list(param = param, IntegrandList=IntegrandList,
-# # var.dx=var.dx, lower.var=lower.var, upper.var=upper.var,
-# # out.var=out.var, dimIntegrand = dimension))
-# }
-#
+# return(list(param = param, IntegrandList=IntegrandList,
+# var.dx=var.dx, lower.var=lower.var, upper.var=upper.var,
+# out.var=out.var, dimIntegrand = dimension))
+}
+
+aux.setIntegral <- function(yuima, integrand, var.dx,
+ lower.var, upper.var, out.var = "", nrow =1 ,ncol=1,
+ type = "Integral"){
+
+
+ if(missing(yuima)){
+ yuima.stop("yuima object is missing.")
+ }
+ if(missing(integrand)){
+ yuima.stop("Integrand function is missing")
+ }
+ if(missing(var.dx)){
+ yuima.stop("dx object is missing.")
+ }
+
+ resFunc<-constFunc(func=integrand, nrow, ncol)
+ Integrand <- resFunc$func
+ dimension <- resFunc$dimens
+
+ modDum <- ExtYuimaMod(yuima)
+ mod <- modDum$mod
+ yuima <- modDum$yuima
+ paramIntegrand <- NULL
+ ddd <- prod(dimension)
+ IntegrandList <- as.list(character(length=ddd))
+ Integrand <- as.character(Integrand)
+
+ for(i in c(1:ddd)){
+ IntegrandList[[i]]<-parse(text=Integrand[i])
+ paramIntegrand<-c(paramIntegrand,all.vars(IntegrandList[[i]]))
+ }
+
+ paramIntegrand<-unique(paramIntegrand)
+ common<-mod at parameter@common
+
+ Cond<-(mod at parameter@all %in% paramIntegrand)
+ common <- c(common,mod at parameter@all[Cond])
+ # solve variable
+ Cond <- (paramIntegrand %in% mod at solve.variable)
+ if(sum(Cond)==0){
+ yuima.warn("Integrand fuction does not depend on solve.variable")
+ }
+
+ paramIntegrand <- paramIntegrand[!Cond]
+ # time variable
+ Cond <- (paramIntegrand %in% mod at time.variable)
+ paramIntegrand <- paramIntegrand[!Cond]
+ # upper.var
+ if((upper.var == mod at time.variable)||(lower.var == mod at time.variable)){
+ yuima.stop("upper.var or lower.var must be different from time.variable")
+ }
+
+ Cond <- (paramIntegrand %in% upper.var)
+ paramIntegrand <- paramIntegrand[!Cond]
+
+ Cond <- (paramIntegrand %in% lower.var)
+ paramIntegrand <- paramIntegrand[!Cond]
+
+ allparam <- c(mod at parameter@all, unique(paramIntegrand))
+
+ if(type == "Integral"){
+ cond1 <-c(var.dx %in% c(mod at solve.variable, mod at time.variable))
+ if(sum(cond1)!=dimension[2]){
+ yuima.stop("var.dx must be contains only components of solve variable or time variable")
+ }
+ }
+ my.param.Integral <- new("param.Integral",
+ allparam = unique(allparam),
+ common = common,
+ Integrandparam = paramIntegrand)
+ my.variable.Integral <- new("variable.Integral",
+ var.dx = var.dx,
+ lower.var = lower.var,
+ upper.var = upper.var,
+ out.var = out.var,
+ var.time = yuima at model@time.variable)
+ my.integrand <- new("Integrand",
+ IntegrandList=IntegrandList,
+ dimIntegrand = dimension)
+
+ my.Integral<-new("Integral.sde",
+ param.Integral = my.param.Integral,
+ variable.Integral = my.variable.Integral,
+ Integrand = my.integrand)
+ res<-new("yuima.Integral",Integral=my.Integral, yuima=yuima)
+ return(res)
+}
+
# setOperator <- function(operator, X, Y,
# out.var = "", nrow =1 ,ncol=1){
# if(is(X, "yuima.model")&& is(Y, "yuima.model")){
Modified: pkg/yuima/R/NewClasses.R
===================================================================
--- pkg/yuima/R/NewClasses.R 2016-03-02 14:06:09 UTC (rev 409)
+++ pkg/yuima/R/NewClasses.R 2016-03-06 16:19:31 UTC (rev 410)
@@ -71,28 +71,28 @@
}
)
#
-# # Class for yuima.integral is structured as follows:
+# Class for yuima.integral is structured as follows:
+
+# param.Integral
+# Integral$param$allparam
+# Integral$param$common
+# Integral$param$IntegrandParam
+
+setClass("param.Integral",representation(allparam = "character",
+ common = "character", Integrandparam = "character")
+)
#
-# # param.Integral
-# # Integral$param$allparam
-# # Integral$param$common
-# # Integral$param$IntegrandParam
+setMethod("initialize","param.Integral",
+ function(.Object, allparam = character(),
+ common = character(),
+ Integrandparam = character()){
+ .Object at allparam <- allparam
+ .Object at common <- common
+ .Object at Integrandparam <- Integrandparam
+ return(.Object)
+ }
+)
#
-# setClass("param.Integral",representation(allparam = "character",
-# common = "character", Integrandparam = "character")
-# )
-#
-# setMethod("initialize","param.Integral",
-# function(.Object, allparam = character(),
-# common = character(),
-# Integrandparam = character()){
-# .Object at allparam <- allparam
-# .Object at common <- common
-# .Object at Integrandparam <- Integrandparam
-# return(.Object)
-# }
-# )
-#
# # variable.Integral
# # Integral$var.dx
# # Integral$lower.var
@@ -100,88 +100,88 @@
# # Integral$out.var
# # Integral$var.time <-"s"
#
-# setClass("variable.Integral",
-# representation(var.dx = "character",
-# lower.var = "character",
-# upper.var = "character",
-# out.var = "character",
-# var.time = "character")
-# )
+setClass("variable.Integral",
+ representation(var.dx = "character",
+ lower.var = "character",
+ upper.var = "character",
+ out.var = "character",
+ var.time = "character")
+)
#
-# setMethod("initialize","variable.Integral",
-# function(.Object,
-# var.dx = character(),
-# lower.var = character(),
-# upper.var = character(),
-# out.var = character(),
-# var.time = character()){
-# .Object at var.dx <- var.dx
-# .Object at lower.var <- lower.var
-# .Object at upper.var <- upper.var
-# .Object at out.var <- out.var
-# .Object at var.time <- var.time
-# return(.Object)
-# }
-# )
+setMethod("initialize","variable.Integral",
+ function(.Object,
+ var.dx = character(),
+ lower.var = character(),
+ upper.var = character(),
+ out.var = character(),
+ var.time = character()){
+ .Object at var.dx <- var.dx
+ .Object at lower.var <- lower.var
+ .Object at upper.var <- upper.var
+ .Object at out.var <- out.var
+ .Object at var.time <- var.time
+ return(.Object)
+ }
+ )
+
+# Integrand
+# Integral$IntegrandList
+# Integral$dimIntegrand
+
+setClass("Integrand",
+ representation(IntegrandList = "list",
+ dimIntegrand = "numeric")
+ )
+setMethod("initialize","Integrand",
+ function(.Object,
+ IntegrandList = list(),
+ dimIntegrand = numeric()){
+ .Object at IntegrandList <- IntegrandList
+ .Object at dimIntegrand <- dimIntegrand
+ return(.Object)
+ }
+ )
#
-# # Integrand
-# # Integral$IntegrandList
-# # Integral$dimIntegrand
-#
-# setClass("Integrand",
-# representation(IntegrandList = "list",
-# dimIntegrand = "numeric")
-# )
-# setMethod("initialize","Integrand",
-# function(.Object,
-# IntegrandList = list(),
-# dimIntegrand = numeric()){
-# .Object at IntegrandList <- IntegrandList
-# .Object at dimIntegrand <- dimIntegrand
-# return(.Object)
-# }
-# )
-#
# # Integral.sde
#
-# setClass("Integral.sde", representation(param.Integral = "param.Integral",
-# variable.Integral = "variable.Integral", Integrand = "Integrand")
-# )
+setClass("Integral.sde", representation(param.Integral = "param.Integral",
+ variable.Integral = "variable.Integral", Integrand = "Integrand")
+)
#
-# setMethod("initialize", "Integral.sde",
-# function(.Object,
-# param.Integral = new("param.Integral"),
-# variable.Integral = new("variable.Integral"),
-# Integrand = new("Integrand")){
-# .Object at param.Integral <- param.Integral
-# .Object at variable.Integral <- variable.Integral
-# .Object at Integrand <- Integrand
-# return(.Object)
-# }
-# )
+setMethod("initialize", "Integral.sde",
+ function(.Object,
+ param.Integral = new("param.Integral"),
+ variable.Integral = new("variable.Integral"),
+ Integrand = new("Integrand")){
+ .Object at param.Integral <- param.Integral
+ .Object at variable.Integral <- variable.Integral
+ .Object at Integrand <- Integrand
+ return(.Object)
+ }
+)
#
# # yuima.Integral
#
-# setClass("yuima.Integral", representation(
-# Integral = "Integral.sde"),
-# contains = "yuima"
-# )
+setClass("yuima.Integral", representation(
+ Integral = "Integral.sde"),
+ contains = "yuima"
+)
#
-# setMethod("initialize", "yuima.Integral",
-# function(.Object,
-# Integral = new("Integral.sde"),
-# yuima = new("yuima")){
-# .Object at Integral <- Integral
-# #.Object at param <- param
-# #.Object at Output <- Output
-# .Object at data <- yuima at data
-# .Object at model <- yuima at model
-# .Object at sampling <- yuima at sampling
-# .Object at characteristic <- yuima at characteristic
-# .Object at functional <- yuima at functional
-# return(.Object)
-# }
-# )
+setMethod("initialize", "yuima.Integral",
+ function(.Object,
+ Integral = new("Integral.sde"),
+ yuima = new("yuima")){
+ .Object at Integral <- Integral
+ #.Object at param <- param
+ #.Object at Output <- Output
+ .Object at data <- yuima at data
+ .Object at model <- yuima at model
+ .Object at sampling <- yuima at sampling
+ .Object at characteristic <- yuima at characteristic
+ .Object at functional <- yuima at functional
+ return(.Object)
+ }
+)
#
Modified: pkg/yuima/R/qmle.R
===================================================================
--- pkg/yuima/R/qmle.R 2016-03-02 14:06:09 UTC (rev 409)
+++ pkg/yuima/R/qmle.R 2016-03-06 16:19:31 UTC (rev 410)
@@ -374,6 +374,7 @@
start <- start[order(oo)]
nm <- names(start)
+
idx.diff <- match(diff.par, nm)
idx.drift <- match(drift.par, nm)
# SMI-2/9/14: idx.measure for CP
Modified: pkg/yuima/R/simulateForMapsIntegralAndOperator.R
===================================================================
--- pkg/yuima/R/simulateForMapsIntegralAndOperator.R 2016-03-02 14:06:09 UTC (rev 409)
+++ pkg/yuima/R/simulateForMapsIntegralAndOperator.R 2016-03-06 16:19:31 UTC (rev 410)
@@ -57,3 +57,122 @@
return(object)
}
+
+# Method for Map
+setMethod("simulate", "yuima.Integral",
+ function(object, nsim=1, seed=NULL, xinit, true.parameter,
+ space.discretized=FALSE, increment.W=NULL, increment.L=NULL, method="euler",
+ hurst, methodfGn="WoodChan",
+ sampling, subsampling,
+ #Initial = 0, Terminal = 1, n = 100, delta,
+ # grid, random = FALSE, sdelta=as.numeric(NULL),
+ # sgrid=as.numeric(NULL), interpolation="none"
+ ...){
+ res <- aux.simulatIntegral(object, nsim = nsim, seed = seed,
+ xinit = xinit, true.parameter = true.parameter,
+ space.discretized = space.discretized, increment.W = increment.W,
+ increment.L = increment.L, method = method, hurst = hurst,
+ methodfGn = methodfGn, sampling = sampling, subsampling = subsampling)
+
+ return(res)
+ }
+)
+
+aux.simulatIntegral <- function(object, nsim = nsim, seed = seed,
+ xinit = xinit, true.parameter = true.parameter, space.discretized = space.discretized,
+ increment.W = increment.W, increment.L = increment.L, method = method, hurst = hurst,
+ methodfGn = methodfGn, sampling = sampling, subsampling = subsampling){
+
+ if(missing(sampling)){
+ sampling <- setSampling()
+ }
+
+ param <- unlist(true.parameter)
+ info.par <- object at Integral@param.Integral
+ info.var <- object at Integral@variable.Integral
+ info.int <- object at Integral@Integrand
+
+ mod1 <- object at model
+ labmod.par <- mod1 at parameter@all
+
+ nm <- names(param)
+ CondModPar <- nm%in%labmod.par
+ ValModPar <- param[CondModPar]
+ IntModPar <- param[!CondModPar]
+
+ #Simulation Internal trajectories
+ sim.Inputs <- simulate(mod1, nsim, seed, xinit, true.parameter,
+ space.discretized, increment.W, increment.L, method, hurst,
+ methodfGn, sampling, subsampling)
+
+ # Data of underlying SDE
+
+ Data <- get.zoo.data(sim.Inputs)
+ time <- index(sim.Inputs at data@original.data)
+ my.env <- new.env()
+ assign(info.var at var.time,time,envir=my.env)
+ for(i in c(1:mod1 at equation.number)){
+ assign(mod1 at solve.variable[i],
+ as.numeric(Data[[i]]), envir = my.env)
+ }
+ df <- character(length=info.int at dimIntegrand[2])
+ M.dX <- matrix(0,
+ nrow = info.int at dimIntegrand[2],
+ ncol = sim.Inputs at sampling@n)
+
+ for(i in c(1:info.int at dimIntegrand[2])){
+ df[i] <- paste0("diff(as.numeric(",info.var at var.dx[i],"))")
+ M.dX[i,] <- eval(parse(text = df[i]), envir = my.env)
+ }
+ for(i in c(1:length(info.par at Integrandparam))){
+ cond <- nm%in%info.par at Integrandparam[i]
+ if(any(cond))
+ assign(nm[cond],param[nm[cond]], envir = my.env)
+ }
+
+ #assign(info.var at var.time,time[-length(time)],envir=my.env)
+
+
+
+# matrInt <-matrix(0, nrow = info.int at dimIntegrand[1],
+# ncol = info.int at dimIntegrand[2])
+ res <- NULL
+ PosInMatr <- matrix(c(1:(info.int at dimIntegrand[2]*info.int at dimIntegrand[1])),
+ nrow = info.int at dimIntegrand[1], ncol = info.int at dimIntegrand[2])
+ for(i in c(1:(length(time)-1))){
+ assign(info.var at upper.var,time[i+1],envir=my.env)
+# assign("jj",1,envir = my.env)
+# CondW <- paste0(info.var at var.time,"[jj] < ",info.var at upper.var)
+# while(eval(parse(text=CondW),envir = my.env)){
+#
+#
+# # *eval(parse(text = paste0(info.var at var.time,"<",info.var at upper.var)),
+# # envir= my.env)
+# my.env$jj <- my.env$jj+1
+# }
+# Inter <- eval(c(info.int at IntegrandList[[1]]),envir = my.env)[1:i]
+ my.fun <- function(my.list, my.env, i){
+ dum <- eval(my.list,envir = my.env)
+ if(length(dum)==1){
+ return(rep(dum,i))
+ }else{
+ return(dum[1:i])
+ }
+ }
+
+ Inter2 <- lapply(info.int at IntegrandList,
+ FUN = my.fun, my.env = my.env, i = i)
+ element <- matrix(0, nrow =info.int at dimIntegrand[1], ncol = 1)
+ for(j in c(1:info.int at dimIntegrand[1])){
+ element[j,] <- sum(diag(matrix(unlist(Inter2[PosInMatr[j,]]),
+ ncol = info.int at dimIntegrand[2])%*%M.dX[,c(1:i)]))
+ }
+ res <- cbind(res, element)
+ }
+ res <- cbind(0,res)
+ rownames(res) <- object at Integral@variable.Integral at out.var
+ my.data <- zoo(x = t(res), order.by = time)
+ data1 <- setData(my.data)
+ object at data <- data1
+ return(object)
+}
Added: pkg/yuima/man/Integral.sde.rd
===================================================================
--- pkg/yuima/man/Integral.sde.rd (rev 0)
+++ pkg/yuima/man/Integral.sde.rd 2016-03-06 16:19:31 UTC (rev 410)
@@ -0,0 +1,15 @@
+\name{Integral.sde}
+\docType{class}
+\alias{Integral.sde}
+\alias{Integral.sde-class}
+%\alias{yuima.Integral}
+%\alias{info.Output}
+%\alias{param.Output}
+\alias{initialize,Integral.sde-method}
+
+\title{Class for the mathematical description of integral of a stochastic process}
+
+\description{
+Auxiliar class for definition of an object of class \code{\link{yuima.Integral}}. see the documentation of \code{\link{yuima.Integral}} for more details.
+}
+
Added: pkg/yuima/man/Integrand.rd
===================================================================
--- pkg/yuima/man/Integrand.rd (rev 0)
+++ pkg/yuima/man/Integrand.rd 2016-03-06 16:19:31 UTC (rev 410)
@@ -0,0 +1,14 @@
+\name{Integrand}
+\docType{class}
+\alias{Integrand}
+\alias{Integrand-class}
+%\alias{yuima.Integral}
+%\alias{info.Output}
+%\alias{param.Output}
+\alias{initialize,Integrand-method}
+
+\title{Class for the mathematical description of integral of a stochastic process}
+
+\description{
+Auxiliar class for definition of an object of class \code{\link{yuima.Integral}}. see the documentation of \code{\link{yuima.Integral}} for more details.
+}
Added: pkg/yuima/man/param.Integral.rd
===================================================================
--- pkg/yuima/man/param.Integral.rd (rev 0)
+++ pkg/yuima/man/param.Integral.rd 2016-03-06 16:19:31 UTC (rev 410)
@@ -0,0 +1,15 @@
+\name{param.Integral}
+\docType{class}
+\alias{param.Integral}
+\alias{param.Integral-class}
+%\alias{yuima.Integral}
+%\alias{info.Output}
+%\alias{param.Output}
+\alias{initialize,param.Integral-method}
+
+\title{Class for the mathematical description of integral of a stochastic process}
+
+\description{
+Auxiliar class for definition of an object of class \code{\link{yuima.Integral}}. see the documentation of \code{\link{yuima.Integral}} for more details.
+}
+
Added: pkg/yuima/man/setIntegral.Rd
===================================================================
--- pkg/yuima/man/setIntegral.Rd (rev 0)
+++ pkg/yuima/man/setIntegral.Rd 2016-03-06 16:19:31 UTC (rev 410)
@@ -0,0 +1,86 @@
+\name{setIntegral}
+\alias{setIntegral}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{Integral of Stochastic Differential Equation}
+\description{
+'\code{setIntegral}' is the constructor of an object of class \link{yuima.Integral}
+}
+\usage{
+setIntegral(yuima, integrand, var.dx, lower.var, upper.var,
+ out.var = "", nrow = 1, ncol = 1)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{yuima}{
+an object of class \code{\link{yuima.model}} that is the SDE.
+}
+ \item{integrand}{
+A matrix or a vector of strings that describe each component of the integrand.
+}
+ \item{var.dx}{ A label that indicates the variable of integration }
+ \item{lower.var}{
+ A label that indicates the lower variable in the support of integration, by default \code{lower.var = 0}.}
+ \item{upper.var}{
+A label that indicates the upper variable in the support of integration, by default \code{upper.var = t}.}
+ \item{out.var}{
+Label for the output
+}
+ \item{nrow}{
+Dimension of output if \code{integrand} is a vector of string.
+}
+ \item{ncol}{Dimension of output if \code{integrand} is a vector of string.}
+}
+%\details{
+%% ~~ If necessary, more details than the description above ~~
+%}
+\value{The constructor returns an object of class \code{\link{yuima.Integral}}.}
+\references{Yuima Documentation}
+\author{The YUIMA Project Team}
+
+\examples{
+\dontrun{
+# Definition Model
+
+Mod1<-setModel(drift=c("a1"), diffusion = matrix(c("s1"),1,1),
+ solve.variable = c("X"), time.variable = "s")
+
+# In this example we define an integral of SDE such as
+# \[
+# I=\int^{t}_{0} b*exp(-a*(t-s))*(X_s-a1*s)dX_s
+# \]
+
+integ <- matrix("b*exp(-a*(t-s))*(X-a1*s)",1,1)
+
+Integral <- setIntegral(yuima = Mod1,integrand = integ,
+ var.dx = "X", lower.var = "0", upper.var = "t",
+ out.var = "", nrow =1 ,ncol=1)
+
+# Structure of slots
+
+is(Integral)
+# Function h in the above definition
+Integral at Integral@Integrand at IntegrandList
+# Dimension of Intgrand
+Integral at Integral@Integrand at dimIntegrand
+
+# all parameters are $\left(b,a,a1,s1\right)$
+Integral at Integral@param.Integral at allparam
+
+# the parameters in the integrand are $\left(b,a,a1\right)$ \newline
+Integral at Integral@param.Integral at Integrandparam
+
+# common parameters are $a1$
+Integral at Integral@param.Integral at common
+
+# integral variable dX_s
+Integral at Integral@variable.Integral at var.dx
+Integral at Integral@variable.Integral at var.time
+
+# lower and upper vars
+Integral at Integral@variable.Integral at lower.var
+Integral at Integral@variable.Integral at upper.var
+
+}
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
Added: pkg/yuima/man/variable.Integral.rd
===================================================================
--- pkg/yuima/man/variable.Integral.rd (rev 0)
+++ pkg/yuima/man/variable.Integral.rd 2016-03-06 16:19:31 UTC (rev 410)
@@ -0,0 +1,14 @@
+\name{variable.Integral}
+\docType{class}
+\alias{variable.Integral}
+\alias{variable.Integral-class}
+%\alias{yuima.Integral}
+%\alias{info.Output}
+%\alias{param.Output}
+\alias{initialize,variable.Integral-method}
+
+\title{Class for the mathematical description of integral of a stochastic process}
+
+\description{
+Auxiliar class for definition of an object of class \code{\link{yuima.Integral}}. see the documentation of \code{\link{yuima.Integral}} for more details.
+}
Added: pkg/yuima/man/yuima.Integral-class.rd
===================================================================
--- pkg/yuima/man/yuima.Integral-class.rd (rev 0)
+++ pkg/yuima/man/yuima.Integral-class.rd 2016-03-06 16:19:31 UTC (rev 410)
@@ -0,0 +1,57 @@
+\name{yuima.Integral-class}
+\docType{class}
+\alias{yuima.Integral-class}
+\alias{yuima.Integral}
+%\alias{info.Output}
+%\alias{param.Output}
+\alias{initialize,yuima.Integral-method}
+\alias{simulate,yuima.Integral-method}
+
+
+\title{Class for the mathematical description of integral of a stochastic process}
+
+\description{
+ The \code{yuima.Integral} class is a class of the \pkg{yuima} package that extends the \code{\link{yuima-class}} it represents a integral of a stochastic process
+
+ \code{ zt = int^{t}_0 h(theta, Xs, s) dXs}
+
+}
+
+\section{Slots}{
+In the following we report the the additional slots of an object of class \code{yuima.Integral} with respect to the \code{\link{yuima-class}}:
+ \describe{
+ \item{\code{Integral}:}{It is an object of class \code{Integral.sde} and it is composed by the following slots:
+ \describe{
+ \item{\code{param.Integral}:}{it is an object of class \code{param.Integral} and it is composed by the following slots:
+ \describe{
+ \item{\code{allparam}:}{labels of all parameters (model and integral).}
+ \item{\code{common}:}{common parameters.}
+ \item{\code{Integrandparam}:}{labels of all parameters only in the integral.}
+ }
+ }
+ \item{\code{variable.Integral}:}{it is an object of class \code{variable.Integral} and it is composed by the following slots:
+ \describe{
+ \item{\code{var.dx}:}{integral variable.}
+ \item{\code{lower.var}:}{lower bound of support.}
+ \item{\code{upper.var}:}{upper bound of support.}
+ \item{\code{out.var}:}{labels of output.}
+ \item{\code{var.time}:}{label of time.}
+ }
+ }
+ \item{\code{Integrand}:}{it is an object of class \code{variable.Integral} and it is composed by the following slots:
+ \describe{
+ \item{\code{IntegrandList}:}{It is a \code{list} that contains the components of integrand \code{h(theta, Xs, s)}.}
+ \item{\code{dimIntegrand}:}{a \code{numeric} object that is the dimensions of the output.}
+ }
+ }
+ }
+ }
+ }
+}
+
+\section{Methods}{
+ \describe{
+ \item{simulate}{simulation method. For more information see
+ \code{\link{simulate}}.}
+ }
+}
Modified: pkg/yuima/man/yuima.Output-class.Rd
===================================================================
--- pkg/yuima/man/yuima.Output-class.Rd 2016-03-02 14:06:09 UTC (rev 409)
+++ pkg/yuima/man/yuima.Output-class.Rd 2016-03-06 16:19:31 UTC (rev 410)
@@ -18,7 +18,7 @@
\code{ zt = h(theta, Xt, Yt, t)}
-where \code{Xt} and \code{Yt} areobject of class \code{\link{yuima.model-class}} or \code{\link{yuima-class}} with the same dimension.
+where \code{Xt} and \code{Yt} are object of class \code{\link{yuima.model-class}} or \code{\link{yuima-class}} with the same dimension.
}
\section{Slots}{
More information about the Yuima-commits
mailing list