[Yuima-commits] r404 - in pkg/yuima: . R man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Mon Feb 15 23:08:24 CET 2016
Author: lorenzo
Date: 2016-02-15 23:08:24 +0100 (Mon, 15 Feb 2016)
New Revision: 404
Added:
pkg/yuima/R/FunctionAndOperators.R
pkg/yuima/R/NewClasses.R
pkg/yuima/R/setHawkes.R
pkg/yuima/R/setMultiModel.R
pkg/yuima/R/simulateForMapsIntegralAndOperator.R
pkg/yuima/R/simulateMultiProcess.R
Modified:
pkg/yuima/DESCRIPTION
pkg/yuima/NAMESPACE
pkg/yuima/R/simulate.R
pkg/yuima/man/yuima.model-class.Rd
Log:
New methods and classes
Modified: pkg/yuima/DESCRIPTION
===================================================================
--- pkg/yuima/DESCRIPTION 2016-01-14 09:50:15 UTC (rev 403)
+++ pkg/yuima/DESCRIPTION 2016-02-15 22:08:24 UTC (rev 404)
@@ -1,7 +1,7 @@
Package: yuima
Type: Package
Title: The YUIMA Project Package for SDEs
-Version: 1.0.78
+Version: 1.0.79
Depends: R(>= 2.10.0), methods, zoo, stats4, utils, expm, cubature, mvtnorm
Author: YUIMA Project Team
Maintainer: Stefano M. Iacus <stefano.iacus at unimi.it>
Modified: pkg/yuima/NAMESPACE
===================================================================
--- pkg/yuima/NAMESPACE 2016-01-14 09:50:15 UTC (rev 403)
+++ pkg/yuima/NAMESPACE 2016-02-15 22:08:24 UTC (rev 404)
@@ -1,200 +1,206 @@
-import("methods")
-
-##importFrom("stats", "end", "time", "start")
-importFrom("graphics", "plot")
-import("zoo")
-importFrom(stats, confint)
-import("stats4")
-import("expm")
-import("mvtnorm")
-import("cubature")
-
-importFrom(utils, toLatex)
-
-importFrom("graphics", "lines")
-importFrom("stats", "qchisq")
-importFrom("utils", "relist")
-
-# 03/07/2015
-importFrom(stats, time)
-importFrom(stats, ts)
-importFrom(stats, rnorm)
-importFrom(stats, na.omit)
-importFrom(stats, dgamma)
-importFrom(stats, optimHess)
-importFrom(stats, filter)
-importFrom(utils, tail)
-importFrom(utils, head)
-importFrom(stats, acf)
-importFrom(stats, fft)
-importFrom(stats, rexp)
-importFrom(stats, approx)
-importFrom(stats, arima0)
-importFrom(stats, frequency)
-importFrom(stats, D)
-importFrom(stats, integrate)
-importFrom(stats, rpois)
-importFrom(stats, runif)
-importFrom(stats, optim)
-importFrom(stats, optimize)
-importFrom(stats, deltat)
-importFrom(stats, pchisq)
-importFrom(stats, symnum)
-importFrom(stats, rchisq)
-importFrom(stats, rgamma)
-importFrom(stats, diffinv)
-importFrom(stats, pnorm)
-importFrom(stats, approxfun)
-importFrom(stats, qnorm)
-importFrom(stats, rbinom)
-importFrom(stats, constrOptim)
-importFrom(stats, dnorm)
-importFrom(stats, deriv)
-importFrom(graphics, points)
-importFrom(stats, end)
-importFrom(stats, start)
-importFrom(utils, str)
-importFrom(stats, sd)
-
-
-exportClasses("yuima",
-"yuima.data",
-"yuima.sampling",
-"yuima.characteristic",
-"yuima.model",
-"model.parameter",
-"yuima.carma",
-"carma.info",
-"yuima.carma.qmle",
-"yuima.poisson",
-"yuima.qmle",
-"yuima.CP.qmle",
-"cogarch.info",
-"yuima.cogarch"
-)
-
-exportMethods(
-"dim",
-"length",
-## "start",
-"plot",
-## "time",
-## "end",
-"simulate",
-"cce",
-"llag",
-"poisson.random.sampling",
-"get.zoo.data",
-"initialize",
-## "ql",
-## "rql",
-## "ml.ql",
-"adaBayes",
-"limiting.gamma",
-"getF",
-"getf",
-"getxinit",
-"gete",
-"simFunctional",
-"F0",
-"Fnorm",
-"asymptotic_term",
-"cbind.yuima"
-)
-
-## function which we want to expose to the user
-## all other functions are used internally by the
-## package
-export(setYuima)
-export(setModel) ## builds sde model
-export(setData)
-export(setSampling)
-export(setCharacteristic)
-export(setCarma)
-export(setPoisson)
-export(dconst)
-export(rconst)
-
-export(setCogarch)
-
-export(dim)
-export(length)
-#export(start)
-export(plot)
-#export(time)
-#export(end)
-
-export(simulate) # simulates couple of processes
-export(subsampling)
-export(cce)
-export(llag)
-export(poisson.random.sampling)
-export(noisy.sampling)
-export(mpv)
-export(bns.test)
-export(hyavar) # asymptotic variance estimator for the Hayashi-Yoshida estimator
-export(lmm) # Oct. 10, 2015: local methods of moment estimator
-export(mllag) # Oct. 10, 2015: multiple lead-lag detector
-
-export(get.zoo.data)
-
-##export(ql,rql,ml.ql)
-##export(rql)
-export(adaBayes)
-export(rIG, rNIG, rbgamma, rngamma, rstable) ##:: random number generator for Inverse Gaussian
-export(limiting.gamma)
-
-export(setFunctional)
-export(getF)
-export(getf)
-export(getxinit)
-export(gete)
-
-export(simFunctional)
-export(F0)
-export(Fnorm)
-export(asymptotic_term)
-
-##export(LSE)
-export(lse)
-
-export(qmle)
-export(quasilogl)
-export(phi.test)
-export(lasso)
-export(CPoint)
-export(qmleR)
-export(qmleL)
-
-
-export(CarmaNoise) # Estimates the Levy in carma model
-export(gmm) # Estimation COGARCH(P,Q) using Method Of Moments
-export(cogarchNoise)
-export(Diagnostic.Cogarch)
-
-
-export(qgv)
-export(mmfrac)
-
-export(cbind.yuima)
-
-S3method(print, phitest)
-S3method(print, qgv)
-S3method(print, mmfrac)
-S3method(print, yuima.lasso)
-S3method(print, yuima.llag) # Oct. 10, 2015
-S3method(print, yuima.mllag) # Oct. 10, 2015
-S3method(print, yuima.specv) # Oct. 10, 2015
-
-
-S3method(toLatex, yuima)
-S3method(toLatex, yuima.model)
-S3method(toLatex, yuima.carma)
-S3method(toLatex, yuima.cogarch)
-
-S3method(plot, yuima.llag) # Oct. 10, 2015
-S3method(plot, yuima.mllag) # Oct. 10, 2015
-
-useDynLib(yuima)
-
-
+import("methods")
+
+##importFrom("stats", "end", "time", "start")
+importFrom("graphics", "plot")
+import("zoo")
+importFrom(stats, confint)
+import("stats4")
+import("expm")
+import("mvtnorm")
+import("cubature")
+
+importFrom(utils, toLatex)
+
+importFrom("graphics", "lines")
+importFrom("stats", "qchisq")
+importFrom("utils", "relist")
+
+# 03/07/2015
+importFrom(stats, time)
+importFrom(stats, ts)
+importFrom(stats, rnorm)
+importFrom(stats, na.omit)
+importFrom(stats, dgamma)
+importFrom(stats, optimHess)
+importFrom(stats, filter)
+importFrom(utils, tail)
+importFrom(utils, head)
+importFrom(stats, acf)
+importFrom(stats, fft)
+importFrom(stats, rexp)
+importFrom(stats, approx)
+importFrom(stats, arima0)
+importFrom(stats, frequency)
+importFrom(stats, D)
+importFrom(stats, integrate)
+importFrom(stats, rpois)
+importFrom(stats, runif)
+importFrom(stats, optim)
+importFrom(stats, optimize)
+importFrom(stats, deltat)
+importFrom(stats, pchisq)
+importFrom(stats, symnum)
+importFrom(stats, rchisq)
+importFrom(stats, rgamma)
+importFrom(stats, diffinv)
+importFrom(stats, pnorm)
+importFrom(stats, approxfun)
+importFrom(stats, qnorm)
+importFrom(stats, rbinom)
+importFrom(stats, constrOptim)
+importFrom(stats, dnorm)
+importFrom(stats, deriv)
+importFrom(graphics, points)
+importFrom(stats, end)
+importFrom(stats, start)
+importFrom(utils, str)
+importFrom(stats, sd)
+
+
+exportClasses("yuima",
+"yuima.data",
+"yuima.sampling",
+"yuima.characteristic",
+"yuima.model",
+"model.parameter",
+"yuima.carma",
+"carma.info",
+"yuima.carma.qmle",
+"yuima.poisson",
+"yuima.qmle",
+"yuima.CP.qmle",
+"cogarch.info",
+"yuima.cogarch",
+"yuima.Output",
+"info.Output",
+"param.Output",
+"yuima.multimodel"
+)
+
+exportMethods(
+"dim",
+"length",
+## "start",
+"plot",
+## "time",
+## "end",
+"simulate",
+"cce",
+"llag",
+"poisson.random.sampling",
+"get.zoo.data",
+"initialize",
+## "ql",
+## "rql",
+## "ml.ql",
+"adaBayes",
+"limiting.gamma",
+"getF",
+"getf",
+"getxinit",
+"gete",
+"simFunctional",
+"F0",
+"Fnorm",
+"asymptotic_term",
+"cbind.yuima"
+)
+
+## function which we want to expose to the user
+## all other functions are used internally by the
+## package
+export(setYuima)
+export(setModel) ## builds sde model
+export(setData)
+export(setSampling)
+export(setCharacteristic)
+export(setCarma)
+export(setPoisson)
+export(dconst)
+export(rconst)
+
+export(setCogarch)
+export(setMaps)
+export(setMultiModel)
+
+export(dim)
+export(length)
+#export(start)
+export(plot)
+#export(time)
+#export(end)
+
+export(simulate) # simulates couple of processes
+export(subsampling)
+export(cce)
+export(llag)
+export(poisson.random.sampling)
+export(noisy.sampling)
+export(mpv)
+export(bns.test)
+export(hyavar) # asymptotic variance estimator for the Hayashi-Yoshida estimator
+export(lmm) # Oct. 10, 2015: local methods of moment estimator
+export(mllag) # Oct. 10, 2015: multiple lead-lag detector
+
+export(get.zoo.data)
+
+##export(ql,rql,ml.ql)
+##export(rql)
+export(adaBayes)
+export(rIG, rNIG, rbgamma, rngamma, rstable) ##:: random number generator for Inverse Gaussian
+export(limiting.gamma)
+
+export(setFunctional)
+export(getF)
+export(getf)
+export(getxinit)
+export(gete)
+
+export(simFunctional)
+export(F0)
+export(Fnorm)
+export(asymptotic_term)
+
+##export(LSE)
+export(lse)
+
+export(qmle)
+export(quasilogl)
+export(phi.test)
+export(lasso)
+export(CPoint)
+export(qmleR)
+export(qmleL)
+
+
+export(CarmaNoise) # Estimates the Levy in carma model
+export(gmm) # Estimation COGARCH(P,Q) using Method Of Moments
+export(cogarchNoise)
+export(Diagnostic.Cogarch)
+
+
+export(qgv)
+export(mmfrac)
+
+export(cbind.yuima)
+
+S3method(print, phitest)
+S3method(print, qgv)
+S3method(print, mmfrac)
+S3method(print, yuima.lasso)
+S3method(print, yuima.llag) # Oct. 10, 2015
+S3method(print, yuima.mllag) # Oct. 10, 2015
+S3method(print, yuima.specv) # Oct. 10, 2015
+
+
+S3method(toLatex, yuima)
+S3method(toLatex, yuima.model)
+S3method(toLatex, yuima.carma)
+S3method(toLatex, yuima.cogarch)
+
+S3method(plot, yuima.llag) # Oct. 10, 2015
+S3method(plot, yuima.mllag) # Oct. 10, 2015
+
+useDynLib(yuima)
+
+
Added: pkg/yuima/R/FunctionAndOperators.R
===================================================================
--- pkg/yuima/R/FunctionAndOperators.R (rev 0)
+++ pkg/yuima/R/FunctionAndOperators.R 2016-02-15 22:08:24 UTC (rev 404)
@@ -0,0 +1,353 @@
+# Method for construction of function and operator of yuima
+# object
+setMaps <- function(func, yuima, out.var = "", nrow =1 ,ncol=1){
+ # A function has three kind of inputs
+ # parameters that is a scalar
+ # Process that is an object of class yuima
+ # Time that is an object of sample grid
+ res <- aux.setMaps(func, yuima, out.var = out.var, nrow =1 ,
+ ncol=1, type="Maps")
+ return(res)
+# if(missing(yuima)){
+# yuima.stop("yuima object is missing.")
+# }
+#
+# if(missing(func)){
+# yuima.stop("function is missing.")
+# return(NULL)
+# }
+#
+# # if(is.array(func)){
+# # dimens<-dim(func)
+# # }else{
+# # if(length(func)!=(nrow*ncol)){
+# # yuima.warn("nrow*ncol is different from the dim of image. f becomes a vector function")
+# # func<-as.matrix(func)
+# # dimens<-dim(func)
+# # }else{
+# # func<-matrix(func,nrow = nrow, ncol = ncol)
+# # dimens<-dim(func)
+# # }
+# # }
+#
+# resFunc<-constFunc(func, nrow, ncol)
+#
+# func <- resFunc$func
+# dimens <- resFunc$dimens
+#
+# # if(is(yuima, "yuima.model")){
+# # mod<-yuima
+# # yuima<-setYuima(model = mod)
+# # }else{
+# # if(is(yuima, "yuima")){
+# # mod<-yuima at model
+# # }else{
+# # yuima.stop("yuima must be an object of class yuima or yuima.model")
+# # }
+# # }
+#
+#
+# modDum <- ExtYuimaMod(yuima)
+# mod <- modDum$mod
+# yuima <- modDum$yuima
+#
+# paramfunc<-NULL
+# ddd<-prod(dimens)
+# funcList<-as.list(character(length=ddd))
+# func<-as.character(func)
+# for(i in c(1:ddd)){
+# funcList[[i]]<-parse(text=func[i])
+# paramfunc<-c(paramfunc,all.vars(funcList[[i]]))
+# }
+# # funcList<-array(funcList,dim=dimens)
+# # for(j in c(1:ncol)){
+# # for(i in c(1:nrow)){
+# # funcList[[i+(j-1)*nrow]]<-parse(text = func[i,j])
+# # paramfunc<-c(paramfunc,all.vars(funcList[[i+(j-1)*nrow]]))
+# # }
+# # }
+# paramfunc<-unique(paramfunc)
+# common<-mod at parameter@common
+#
+# Cond<-(mod at parameter@all %in% paramfunc)
+# common <- c(common,mod at parameter@all[Cond])
+# Cond <- (paramfunc %in% mod at solve.variable)
+# if(sum(Cond)==0){
+# yuima.warn("function does not depend on solve.variable")
+# }
+# paramfunc<-paramfunc[!Cond]
+#
+# Cond <- (paramfunc %in% mod at time.variable)
+# paramfunc <- paramfunc[!Cond]
+# if(length(out.var)==1){
+# out.var<-rep(out.var,ddd)
+# }
+# param <- new("param.Output",
+# out.var = out.var,
+# allparam = unique(c(paramfunc,mod at parameter@all)),
+# allparamMap = paramfunc,
+# common = common,
+# Input.var = mod at solve.variable,
+# time.var=mod at time.variable)
+#
+# objFunc <- new("info.Output", formula = funcList,
+# dimension=dimens, type ="Maps")
+#
+# res<-new("yuima.Output",
+# param = param,
+# Output = objFunc,
+# yuima=yuima )
+#
+# return(res)
+}
+
+aux.setMaps <- function(func, yuima, out.var = "",
+ nrow =1 ,ncol=1, type="Maps"){
+ if(missing(yuima)){
+ yuima.stop("yuima object is missing.")
+ }
+
+ if(missing(func)){
+ yuima.stop("function is missing.")
+ return(NULL)
+ }
+
+ # if(is.array(func)){
+ # dimens<-dim(func)
+ # }else{
+ # if(length(func)!=(nrow*ncol)){
+ # yuima.warn("nrow*ncol is different from the dim of image. f becomes a vector function")
+ # func<-as.matrix(func)
+ # dimens<-dim(func)
+ # }else{
+ # func<-matrix(func,nrow = nrow, ncol = ncol)
+ # dimens<-dim(func)
+ # }
+ # }
+
+ resFunc<-constFunc(func, nrow, ncol)
+
+ func <- resFunc$func
+ dimens <- resFunc$dimens
+
+ # if(is(yuima, "yuima.model")){
+ # mod<-yuima
+ # yuima<-setYuima(model = mod)
+ # }else{
+ # if(is(yuima, "yuima")){
+ # mod<-yuima at model
+ # }else{
+ # yuima.stop("yuima must be an object of class yuima or yuima.model")
+ # }
+ # }
+
+
+ modDum <- ExtYuimaMod(yuima)
+ mod <- modDum$mod
+ yuima <- modDum$yuima
+
+ paramfunc<-NULL
+ ddd<-prod(dimens)
+ funcList<-as.list(character(length=ddd))
+ func<-as.character(func)
+ for(i in c(1:ddd)){
+ funcList[[i]]<-parse(text=func[i])
+ paramfunc<-c(paramfunc,all.vars(funcList[[i]]))
+ }
+ # funcList<-array(funcList,dim=dimens)
+ # for(j in c(1:ncol)){
+ # for(i in c(1:nrow)){
+ # funcList[[i+(j-1)*nrow]]<-parse(text = func[i,j])
+ # paramfunc<-c(paramfunc,all.vars(funcList[[i+(j-1)*nrow]]))
+ # }
+ # }
+ paramfunc<-unique(paramfunc)
+ common<-mod at parameter@common
+
+ Cond<-(mod at parameter@all %in% paramfunc)
+ common <- c(common,mod at parameter@all[Cond])
+ Cond <- (paramfunc %in% mod at solve.variable)
+ if(sum(Cond)==0){
+ yuima.warn("function does not depend on solve.variable")
+ }
+ paramfunc<-paramfunc[!Cond]
+
+ Cond <- (paramfunc %in% mod at time.variable)
+ paramfunc <- paramfunc[!Cond]
+ if(length(out.var)==1){
+ out.var<-rep(out.var,ddd)
+ }
+ param <- new("param.Output",
+ out.var = out.var,
+ allparam = unique(c(paramfunc,mod at parameter@all)),
+ allparamMap = paramfunc,
+ common = common,
+ Input.var = mod at solve.variable,
+ time.var=mod at time.variable)
+
+ objFunc <- new("info.Output", formula = funcList,
+ dimension=dimens, type = type,
+ param=param)
+
+ res<-new("yuima.Output",
+ Output = objFunc,
+ yuima=yuima )
+
+ return(res)
+}
+
+
+# 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)
+#
+# # 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))
+# }
+#
+# setOperator <- function(operator, X, Y,
+# out.var = "", nrow =1 ,ncol=1){
+# if(is(X, "yuima.model")&& is(Y, "yuima.model")){
+# modtot <- rbind(X,Y)
+# }
+# #assign("mod1",mod1)
+# Oper<- strsplit(operator,split="")[[1]]
+# if(mod1 at equation.number!=mod2 at equation.number){
+# yuima.stop("the models must have the same dimension")
+# }
+# func <- matrix(character(),mod1 at equation.number,1)
+# condX <- (Oper %in% "X")
+# condY <- (Oper %in% "Y")
+# for(i in c(1:mod1 at equation.number)){
+# dummyCond <- Oper
+# dummyCond[condX] <- X at solve.variable[i]
+# dummyCond[condY] <- Y at solve.variable[i]
+# func[i,] <- paste0(dummyCond,collapse ="")
+# }
+# # res <- setMaps(func = func, yuima = modtot,
+# # out.var = out.var, nrow = nrow , ncol = ncol)
+# res <- aux.setMaps(func = func, yuima = modtot,
+# out.var = out.var, nrow = nrow ,
+# ncol=ncol, type="Operator")
+# return(res)
+# }
+#
+# setIntensity <- function(...){
+# return(NULL)
+# }
+
+constFunc<-function(func, nrow, ncol){
+ if(is.array(func)){
+ dimens<-dim(func)
+ }else{
+ if(length(func)!=(nrow*ncol)){
+ yuima.warn("nrow*ncol is different from the dim of image. f becomes a vector function")
+ func<-as.matrix(func)
+ dimens<-dim(func)
+ }else{
+ func<-matrix(func,nrow = nrow, ncol = ncol)
+ dimens<-dim(func)
+ }
+ }
+ return(list(func=func, dimens = dimens))
+}
+
+ExtYuimaMod <- function(yuima){
+ if(is(yuima, "yuima.model")){
+ mod<-yuima
+ yuima<-setYuima(model = mod)
+ }else{
+ if(is(yuima, "yuima")){
+ mod<-yuima at model
+ }else{
+ yuima.stop("yuima must be an object of class yuima or yuima.model")
+ }
+ }
+ return(list(mod=mod, yuima=yuima))
+}
+
Added: pkg/yuima/R/NewClasses.R
===================================================================
--- pkg/yuima/R/NewClasses.R (rev 0)
+++ pkg/yuima/R/NewClasses.R 2016-02-15 22:08:24 UTC (rev 404)
@@ -0,0 +1,192 @@
+# Here we insert new classes for extending the object of classes yuima
+setClass("param.Output",
+ representation(out.var = "character",
+ allparam = "character",
+ allparamMap = "character",
+ common = "character",
+ Input.var = "character",
+ time.var = "character"))
+
+setClass("info.Output",
+ representation(formula="list",
+ dimension="numeric",
+ type="character",
+ param = "param.Output"))
+
+
+setClass("yuima.Output",
+ representation(Output = "info.Output"),
+ contains="yuima"
+ )
+
+# Initialization
+
+setMethod("initialize",
+ "param.Output",
+ function(.Object, out.var = character(),
+ allparam = character(),
+ allparamMap = character(),
+ common = character(),
+ Input.var = character(),
+ time.var = character()){
+ .Object at out.var <- out.var
+ .Object at allparam <- allparam
+ .Object at allparamMap <- allparamMap
+ .Object at common <- common
+ .Object at Input.var <-Input.var
+ .Object at time.var <- time.var
+ return(.Object)
+ }
+)
+#
+setMethod("initialize",
+ "info.Output", function(.Object,
+ formula = list(),
+ dimension = numeric(),
+ type = character(),
+ param = new("param.Output")){
+ .Object at formula <- formula
+ .Object at dimension <- dimension
+ .Object at type <- type
+ .Object at param <- param
+ return(.Object)
+ }
+ )
+
+setMethod("initialize",
+ "yuima.Output",
+ function(.Object,
+ #param = new("param.Output"),
+ Output = new("info.Output"),
+ yuima = new("yuima")){
+ #.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)
+
+ }
+)
+#
+# # 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")
+# )
+#
+# 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
+# # Integral$upper.var
+# # 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")
+# )
+#
+# 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)
+# }
+# )
+#
+# # Integral.sde
+#
+# 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)
+# }
+# )
+#
+# # yuima.Integral
+#
+# 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)
+# }
+# )
+#
+
+
+# yuima.multimodel. We replacate the yuima.model class in order to
+# describe from mathematical point of view the multi dimensional jump
+# diffusion model
+setClass("yuima.multimodel",
+ contains="yuima.model")
Added: pkg/yuima/R/setHawkes.R
===================================================================
--- pkg/yuima/R/setHawkes.R (rev 0)
+++ pkg/yuima/R/setHawkes.R 2016-02-15 22:08:24 UTC (rev 404)
@@ -0,0 +1,49 @@
+# setHawkes <- function(yuima, counting.var="N", gFun, Kernel,
+# var.dx, var.dt = "s", lambda.var = "lambda",
+# lower.var="0", upper.var = "t",
+# nrow =1 ,ncol=1){
+#
+# g <- yuima:::setMaps(func = gFun, yuima = yuima,
+# nrow = nrow, ncol = ncol)
+#
+# yuimadum <- yuima
+# yuimadum at time.variable <- var.dt
+#
+# HawkesType <- FALSE
+# if(counting.var %in% var.dx){
+# HawkesType <- TRUE
+# }
+# if(!HawkesType){
+# Integral <- yuima:::setIntegral(yuima=yuimadum,
+# integrand = Kernel, var.dx = var.dx,
+# lower.var = lower.var, upper.var = upper.var,
+# out.var = "", nrow = nrow, ncol = ncol)
+# }else{
+# Integral <- yuima:::setIntegral(yuima=yuimadum,
+# integrand = Kernel, var.dx = var.dx,
+# lower.var = lower.var, upper.var = upper.var,
+# out.var = "", nrow = nrow, ncol = ncol, type ="")
+# }
+# if(g at Output@dimension[1]!=Integral$dimIntegrand[1]){
+# yuima.stop("dimension gFun and kernel mismatch")
+# }
+#
+#
+# allparam <-unique(c(yuima at parameter@all, g at param@allparamMap,
+# Integral$param$IntegrandParam))
+# common <- unique(c(g at param@common, Integral$param$common))
+# paramHawkes <- list(allparam = allparam, common = common,
+# gFun = g at param@allparamMap,
+# Kern = Integral$param$IntegrandParam)
+#
+# # IntPpr<- yuima:::setIntegral(yuima=yuimadum,
+# # integrand = Kernel, var.dx = "N",
+# # lower.var = lower.var, upper.var = upper.var,
+# # out.var = "", nrow = nrow, ncol = ncol)
+#
+# return(list(Count.Proc = counting.var,
+# gFun = list(param=g at param, output=g at Output),
+# Kernel = Integral, paramHawkes = paramHawkes,
+# model = yuima, SelfEx = HawkesType))
+#
+# }
Added: pkg/yuima/R/setMultiModel.R
===================================================================
--- pkg/yuima/R/setMultiModel.R (rev 0)
+++ pkg/yuima/R/setMultiModel.R 2016-02-15 22:08:24 UTC (rev 404)
@@ -0,0 +1,559 @@
+setMethod("initialize", "yuima.multimodel",
+ function(.Object,
+ #model = new("yuima.model")
+ drift = expression() ,
+ diffusion = list() ,
+ hurst = 0.5,
+ jump.coeff = list(),
+ #jump.coeff = expression(),
+ measure=list(),
+ measure.type=character(),
+ parameter = new("model.parameter"),
+ state.variable = "x",
+ jump.variable = "z",
+ time.variable = "t",
+ noise.number = numeric(),
+ equation.number = numeric(),
+ dimension = numeric(),
+ solve.variable = character(),
+ xinit = expression(),
+ J.flag = logical()
+ ){
+ .Object at drift <- drift
+ .Object at diffusion <- diffusion
+ .Object at hurst <- hurst
+ .Object at jump.coeff <- jump.coeff
+ .Object at measure <- measure
+ .Object at measure.type <- measure.type
+ .Object at parameter <- parameter
+ .Object at state.variable <- state.variable
+ .Object at jump.variable <- jump.variable
+ .Object at time.variable <- time.variable
+ .Object at noise.number <- noise.number
+ .Object at equation.number <- equation.number
+ .Object at dimension <- dimension
+ .Object at solve.variable <- solve.variable
+ .Object at xinit <- xinit
+ .Object at J.flag <- J.flag
+ return(.Object)
+ })
+
+
+
+# We need a function that construct a Multivariate Model
+setMultiModel <- function(drift=NULL,
+ diffusion=NULL,
+ hurst=0.5,
+ jump.coeff=NULL,
+ intensity = NULL,
+ df = NULL,
+# jump.dimens = NULL,
+# measure=list(),
+ measure.type=character(),
+ state.variable="x",
+ jump.variable="z",
+ time.variable="t",
+ solve.variable,
+ xinit=NULL){
+ ## we need a temp env for simplifications
+
+ yuimaENV <- new.env()
+ ##::measure and jump term #####################################
+
+ ##::initialize objects ########
+ MEASURE <- list()
+
+ ##::end initialize objects ########
+
+ ##::make type function list ####
+ CPlist <- c("dnorm", "dgamma", "dexp", "dconst")
+ codelist <- c("rIG", "rNIG", "rgamma", "rbgamma", "rngamma", "rstable")
+ ##::end make type function list ####
+ jump.dimens <- dim(jump.coeff)[2]
+ numbMeasure <- length(measure.type)
+ if(numbMeasure>0){
+ if(numbMeasure!=1){
+ if(jump.dimens!=numbMeasure){
+ yuima.stop("dimension of jump is not coherent")
+ }
+ }
+
+
+# if(!length(measure.type)){
+# if( length(jump.coeff) || length(measure) ){
+# yuima.warn("measure type does not match with jump term.")
+# return(NULL)
+# }
+# jump.variable <- character()
+
+ measure.par <- character()
+ if(any(measure.type=="CP")){
+ tmp.measure <- list(df=list(func=vector(mode="list", length=1),
+ expr=as.expression(rep("0",1))),
+ intensity=as.expression(rep("0",length(intensity))))
+ }else{
+
+ tmp.measure <- list(df=list(func=vector(mode="list", length=length(measure.type)),
+ expr=as.expression(rep("0",1))))
+
+ }
+# measure.par <- character()
+# }else{
+# tmp.measure <- list(df=list(func=vector(mode="list",
+# length=length(measure.type)),
+# expr=as.expression(rep("0",length(measure.type)))),
+# intensity=as.expression(rep("0",sum(measure.type=="CP"))))
+# if( !length(jump.coeff) || !length(measure) ){
+# yuima.warn("measure type isn't matched with jump term.")
+# return(NULL)
+# # }else
+# # if(length(jump.coeff)!=1){
+# # yuima.warn("multi dimentional jump term is not supported yet.")
+# #
+# # return(NULL)
+# # }
+#
+# }
+ if("CP" %in% measure.type){
+ condCP <- (measure.type%in%"CP")
+ numbCP<-sum(condCP)
+ h <- 0
+ for(i in c(1:length(measure.type))){
+ if(length(measure.type[condCP[i]])!=0){
+ if(!is.na(intensity[i-h])){
+ tmp.measure$intensity[(i-h)] <- parse(text = intensity[i-h])
+ }
+ measure.par <- c(measure.par,all.vars(tmp.measure$intensity[(i-h)]))
+ }else{
+ h<-h+1
+ }
+ }
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/yuima -r 404
More information about the Yuima-commits
mailing list