[Yuima-commits] r503 - in pkg/yuima: . R
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Mon Oct 31 21:25:14 CET 2016
Author: lorenzo
Date: 2016-10-31 21:25:14 +0100 (Mon, 31 Oct 2016)
New Revision: 503
Modified:
pkg/yuima/DESCRIPTION
pkg/yuima/R/MethodForLaw.R
pkg/yuima/R/simulate.R
pkg/yuima/R/simulateMultiProcess.R
pkg/yuima/R/yuima.model.R
Log:
update ppr and yuima.law
Modified: pkg/yuima/DESCRIPTION
===================================================================
--- pkg/yuima/DESCRIPTION 2016-10-30 02:55:58 UTC (rev 502)
+++ pkg/yuima/DESCRIPTION 2016-10-31 20:25:14 UTC (rev 503)
@@ -1,7 +1,7 @@
Package: yuima
Type: Package
Title: The YUIMA Project Package for SDEs
-Version: 1.3.1
+Version: 1.3.2
Depends: R(>= 2.10.0), methods, zoo, stats4, utils, expm, cubature, mvtnorm
Imports: Rcpp (>= 0.12.1)
Author: YUIMA Project Team
Modified: pkg/yuima/R/MethodForLaw.R
===================================================================
--- pkg/yuima/R/MethodForLaw.R 2016-10-30 02:55:58 UTC (rev 502)
+++ pkg/yuima/R/MethodForLaw.R 2016-10-31 20:25:14 UTC (rev 503)
@@ -1,9 +1,9 @@
aux.funForLaw <- function(object, param, my.env, dummy){
- param <- unlist(param)
+ # param <- unlist(param)
name.par <- names(param)
if(length(object at time.var)>=1){
if(object at time.var%in%name.par){
- assign(object at time.var,param[object at time.var], envir = my.env)
+ assign(object at time.var,param[[object at time.var]], envir = my.env)
}else{
yuima.stop("time.var is not assigned")
}
@@ -15,8 +15,8 @@
yuima.stop("mismatch arguments")
}
for(i in c(1: length(param))){
- cond<-object at param.measure %in% name.par[i]
- assign(object at param.measure[cond], param[i], envir = my.env)
+ cond<-object at param.measure %in% name.par[[i]]
+ assign(object at param.measure[cond], param[[i]], envir = my.env)
}
}
res <- eval(parse(text=dummy),envir=my.env)
Modified: pkg/yuima/R/simulate.R
===================================================================
--- pkg/yuima/R/simulate.R 2016-10-30 02:55:58 UTC (rev 502)
+++ pkg/yuima/R/simulate.R 2016-10-31 20:25:14 UTC (rev 503)
@@ -79,7 +79,9 @@
grid, random, sdelta,
sgrid, interpolation)
}else{
- if(is(object at model,"yuima.multimodel")){
+ if(is(object at model,"yuima.multimodel")||
+ is(object at model@measure$df,"yuima.law")
+ ){
res <- aux.simulate.multimodel(object, nsim, seed, xinit, true.parameter,
space.discretized, increment.W, increment.L,method,
hurst,methodfGn,
Modified: pkg/yuima/R/simulateMultiProcess.R
===================================================================
--- pkg/yuima/R/simulateMultiProcess.R 2016-10-30 02:55:58 UTC (rev 502)
+++ pkg/yuima/R/simulateMultiProcess.R 2016-10-31 20:25:14 UTC (rev 503)
@@ -31,7 +31,7 @@
aux.simulate.multimodel<-function(object, nsim, seed, xinit, true.parameter,
space.discretized, increment.W, increment.L,method,
- hurst,methodfGn,
+ hurst=0.5,methodfGn,
sampling, subsampling,
Initial, Terminal, n, delta,
grid, random, sdelta,
@@ -39,7 +39,66 @@
##:: errors checks
+ if(is(object at model@measure$df,"yuima.law")&& is.null(increment.L)){
+ randomGenerator<-object at model@measure$df
+ if(samp at regular){
+ tForMeas<-samp at delta
+ NumbIncr<-samp at n
+ if(missing(true.parameter)){
+ eval(parse(text= paste0("measureparam$",
+ object at model@time.variable," <- tForMeas",collapse="")))
+ }else{
+ measureparam<-true.parameter[object at model@parameter at measure]
+ eval(parse(text= paste0("measureparam$",
+ object at model@time.variable," <- tForMeas",collapse="")))
+ }
+ Noise<- rand(object = randomGenerator, n=NumbIncr, param=measureparam)
+ }else{
+ # Just For Irregular Grid
+ tForMeas<-diff(samp at grid[[1]]-samp at Initial)
+ my.InternalFunforLevy<-function(tForMeas,
+ randomGenerator,
+ true.parameter,object){
+ if(missing(true.parameter)){
+ eval(parse(text= paste0("measureparam$",
+ object at model@time.variable," <- tForMeas",collapse="")))
+ }else{
+ measureparam<-true.parameter[object at model@parameter at measure]
+ eval(parse(text= paste0("measureparam$",
+ object at model@time.variable," <- tForMeas",collapse="")))
+
+ }
+ Noise<- rand(object = randomGenerator, n=1, param=measureparam)
+ }
+ Noise<-sapply(X=tForMeas, FUN=my.InternalFunforLevy,
+ randomGenerator=randomGenerator,
+ true.parameter=true.parameter,
+ object=object)
+ }
+ increment.L=Noise
+
+ if(is(object at model@measure$df,"yuima.law")&&!is.null(increment.L)){
+ dummy<-object
+ dummy at model@measure$df <- expression()
+ if(missing(xinit)){
+ res<- aux.simulate.multimodel(object=dummy, nsim, xinit=object at model@xinit ,seed, true.parameter,
+ space.discretized, increment.W,
+ increment.L = t(increment.L), method, hurst, methodfGn,
+ sampling=object at sampling)
+ }else{
+ res<- aux.simulate.multimodel(object=dummy, nsim, xinit, seed, true.parameter,
+ space.discretized, increment.W,
+ increment.L = increment.L, method, hurst, methodfGn,
+ sampling=object at sampling)
+ }
+ res at model <- object at model
+ if(missing(subsampling))
+ return(res)
+ return(subsampling(res, subsampling))
+
+ }
+ }
##:1: error on yuima model
yuima <- object
@@ -176,7 +235,7 @@
##:: using Euler-Maruyama method
- delta <- Terminal/n
+ delta <- samp at delta
if(missing(increment.W) | is.null(increment.W)){
@@ -194,7 +253,7 @@
} else {
- delta<-Terminal/n
+ delta<-samp at delta
if(!is.Poisson(sdeModel)){ # if pure CP no need to setup dW
dW <- rnorm(n * r.size, 0, sqrt(delta))
dW <- matrix(dW, ncol=n, nrow=r.size,byrow=TRUE)
@@ -331,16 +390,17 @@
# yuima.stop("Levy with CP and/or code")
}
- if(!is.null(increment.L))
- Incr.levy<-t(increment.L)
- assign("dL",t(Incr.levy),envir=yuimaEnv)
- sim <- Multi.Euler(xinit,yuima,dW,env=yuimaEnv)
-
}
-# yuima at data@zoo.data <- NULL
- yuima at data@zoo.data<-as.list(numeric(length=length(sim at zoo.data)))
+ if(!is.null(increment.L))
+ Incr.levy<-t(increment.L)
+ assign("dL",t(Incr.levy),envir=yuimaEnv)
+ sim <- Multi.Euler(xinit,yuima,dW,env=yuimaEnv)
+
+
+ yuima at data@zoo.data<-as.list(numeric(length=length(sim at zoo.data))) #LM nov2016
+# yuima at data@zoo.data<-sim at zoo.data
for(i in 1:length(yuima at data@zoo.data)){
yuima at data@zoo.data[[i]]<-sim at zoo.data[[i]]
index(yuima at data@zoo.data[[i]]) <- yuima at sampling@grid[[1]]
Modified: pkg/yuima/R/yuima.model.R
===================================================================
--- pkg/yuima/R/yuima.model.R 2016-10-30 02:55:58 UTC (rev 502)
+++ pkg/yuima/R/yuima.model.R 2016-10-31 20:25:14 UTC (rev 503)
@@ -130,8 +130,20 @@
solve.variable,
xinit=NULL){
## we need a temp env for simplifications
+ mylengdumMeas<-length(measure)
+ if(mylengdumMeas>0){
+ for(i in c(1:mylengdumMeas)){
+ if(is(measure[[i]],"yuima.law")){
+ res<- aux.setModelLaw(drift,diffusion,
+ hurst, jump.coeff, measure, measure.type,
+ state.variable, jump.variable, time.variable,
+ solve.variable, xinit, posyuimalaw=i)
+ res at measure[[i]]<-measure[[i]]
+ return(res)
+ }
+ }
+ }
-
yuimaENV <- new.env()
##::measure and jump term #####################################
@@ -609,6 +621,26 @@
J.flag <- J.flag)
return(tmp)
}
+
+aux.setModelLaw <- function(drift,diffusion,
+ hurst, jump.coeff, measure, measure.type,
+ state.variable, jump.variable, time.variable,
+ solve.variable, xinit, posyuimalaw){
+
+ dummyMeasure <- paste0(c("yuima.law(",
+ paste0(measure[[posyuimalaw]]@param.measure,collapse=", ")
+ ,")"), collapse="")
+ auxmeasure <- measure
+ auxmeasure[[posyuimalaw]]<-dummyMeasure
+ names(auxmeasure[posyuimalaw]) <- "df"
+ setModel(drift = drift,diffusion = diffusion,
+ hurst = hurst, jump.coeff = jump.coeff, measure = auxmeasure,
+ measure.type = measure.type,
+ state.variable = state.variable,
+ jump.variable = jump.variable, time.variable,
+ solve.variable, xinit)
+}
+
# yuima.model rbind
# setGeneric("rbind.yuima",
More information about the Yuima-commits
mailing list