[Yuima-commits] r519 - in pkg/yuima: . R
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Mon Nov 14 16:02:40 CET 2016
Author: lorenzo
Date: 2016-11-14 16:02:40 +0100 (Mon, 14 Nov 2016)
New Revision: 519
Modified:
pkg/yuima/DESCRIPTION
pkg/yuima/R/DiagnosticCarma.R
pkg/yuima/R/simulateForPpr.R
Log:
Ppr simulation and Carma
Modified: pkg/yuima/DESCRIPTION
===================================================================
--- pkg/yuima/DESCRIPTION 2016-11-13 12:43:45 UTC (rev 518)
+++ pkg/yuima/DESCRIPTION 2016-11-14 15:02:40 UTC (rev 519)
@@ -1,7 +1,7 @@
Package: yuima
Type: Package
Title: The YUIMA Project Package for SDEs
-Version: 1.3.8
+Version: 1.3.9
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/DiagnosticCarma.R
===================================================================
--- pkg/yuima/R/DiagnosticCarma.R 2016-11-13 12:43:45 UTC (rev 518)
+++ pkg/yuima/R/DiagnosticCarma.R 2016-11-14 15:02:40 UTC (rev 519)
@@ -42,5 +42,6 @@
statCond<-FALSE
if(min(yuima.PhamBreton.Alg(ar.par[numb.ar:1]))>=0)
statCond<-TRUE
+ return(statCond)
}
Modified: pkg/yuima/R/simulateForPpr.R
===================================================================
--- pkg/yuima/R/simulateForPpr.R 2016-11-13 12:43:45 UTC (rev 518)
+++ pkg/yuima/R/simulateForPpr.R 2016-11-14 15:02:40 UTC (rev 519)
@@ -45,6 +45,27 @@
}
)
+constHazIntPr <- function(g.Fun = object at gFun@formula,
+ Kern.Fun = object at Kernel){
+ numb.Int <- length(g.Fun)
+ Int.Intens <- list()
+ for(i in c(1:numb.Int)){
+ dum.g <- as.character(g.Fun[i])
+ dum.Ker <- as.character(Kern.Fun at Integrand@IntegrandList[[i]])
+ dif.dx <- paste("d",Kern.Fun at variable.Integral@var.dx, sep="")
+ dum.Ker <- paste(dum.Ker,dif.dx, sep = "*")
+ if(length(dum.Ker)>1){
+ dum.Ker <- paste(dum.Ker,collapse = "+")
+ }
+ dum.Ker <- paste("(",dum.Ker,") * (")
+ cond.Sup <- paste(Kern.Fun at variable.Integral@var.time, "<", Kern.Fun at variable.Integral@upper.var)
+ dum.Ker <- paste(dum.Ker, cond.Sup, ")")
+ dum.Ker <- paste0("sum(",dum.Ker,")")
+ Int.Intens[[i]] <- parse(text = paste(dum.g, dum.Ker, sep = " + "))
+ }
+ res <- list(Intens = Int.Intens)
+}
+
aux.simulatPpr<- function(object, nsim = nsim, seed = seed,
xinit = xinit, true.parameter = true.parameter,
space.discretized = space.discretized, increment.W = increment.W,
@@ -202,6 +223,221 @@
sampling = samp)
}
}
+ }else{
+ if(!object at Ppr@RegressWithCount && object at Ppr@IntensWithCount){
+ ## Here we consider the case where we have a counting variable in the intensity but
+ ## we haven't it in the coefficients of the covariates.
+
+ # Simulation of the noise
+ DummyT <- c(true.parameter[Model at parameter@measure], samp at delta)
+ names(DummyT) <- c(names(true.parameter[Model at parameter@measure]),
+ Model at time.variable)
+ increment.L <- rand(object = Model at measure$df,
+ n = samp at n ,
+ param = DummyT)
+ if(!is.matrix(increment.L)){
+ increment.L <- matrix(increment.L,ncol = 1)
+ }
+ if(missing(xinit)){
+ simMod <- simulate(object = Model, hurst = hurst,
+ sampling = samp,
+ true.parameter = true.parameter[Model at parameter@all],
+ increment.L = t(increment.L))
+ }else{
+ simMod <- simulate(object = Model, hurst = hurst,
+ sampling = samp, xinit =xinit,
+ true.parameter = true.parameter[Model at parameter@all],
+ increment.L = t(increment.L))
+ }
+
+ colnames(simMod at data@original.data) <- Model at solve.variable
+
+ Data.tot <- as.matrix(simMod at data@original.data)
+
+ ExprHaz <- constHazIntPr(g.Fun = object at gFun@formula,
+ Kern.Fun = object at Kernel)$Intens
+
+ if(length(ExprHaz)==1){
+
+ Time <- samp at Initial
+
+ my.env <- new.env()
+ for(i in c(1:length(object at Ppr@allparam))){
+ assign(object at Ppr@allparam[i],
+ as.numeric(true.parameter[object at Ppr@allparam[i]]),
+ envir = my.env)
+ }
+
+ Loop <- TRUE
+ TopposInGridInOld <- 0
+
+
+ IntensityProc <- 0
+ solveLambdaInOld <- NULL
+
+ cost <- runif(1)
+ exit <- FALSE
+
+
+ #errorTermTrueOld <- NULL
+
+ TopposInGridIn <- TopposInGridInOld + 1
+
+ TotposInGrid <- samp at n+1
+ TotposInGrid <- TotposInGrid
+
+
+
+ if(is.null(solveLambdaInOld)){
+ solveLambdaOld <- -log(cost)
+ }else{
+ if(TopposInGridIn>1){
+ solveLambdaOld <- solveLambdaInOld
+ }else{
+
+ dummyLambda <- numeric(length=(TopposInGridIn-1))
+ if(length(Kern at variable.Integral@var.dx)==1){
+ dN <- rep(0, (TopposInGridIn))
+ dN[(TopposInGridIn)] <- as.numeric(simMod at data@original.data[TopposInGridIn,Kern at variable.Integral@var.dx]
+ -simMod at data@original.data[TopposInGridIn-1,Kern at variable.Integral@var.dx])
+ }else{
+
+ }
+ for(i in c(2:(TopposInGridIn))){
+ posInGrid <- i
+ LastTime <- samp at grid[[1]][(posInGrid)]
+ LastStime <- samp at grid[[1]][c(1:(posInGrid-1))]
+ assign(Model at time.variable, LastTime, envir = my.env)
+ assign(Kern at variable.Integral@var.time, LastStime, envir = my.env)
+ assign(paste0("d",Kern at variable.Integral@var.dx), dN[c(1:posInGrid)], envir =my.env)
+ dummyLambda[i] <- eval(ExprHaz[[1]], envir=my.env)
+ }
+
+
+ SolvelambdaOld <- -log(cost)-sum(dummyLambda)
+
+ if(solveLambdaInOld*solveLambdaOld<0){
+ TotposInGridOld <- (TopposInGridIn-1)
+ exit <- TRUE
+ Time <- c(Time,my.env$t)
+ IntensityProc<- c(IntensityProc,tail(dummyLambda,n=1L))
+ TotposInGridFin <- (TopposInGridIn-1)
+ TotposInGrid <- TopposInGridIn
+ res <- list(IntensityProc=IntensityProc, TotposInGrid=TotposInGrid,
+ exit = exit, TotposInGridFin=TotposInGridFin,
+ TotposInGridOld =TotposInGridOld)
+ # return(res)
+ }
+ }
+ }
+
+
+
+
+ dummyLambda <- numeric(length=(TotposInGrid-1))
+ if(length(Kern at variable.Integral@var.dx)==1){
+ dN <- rep(0, (TotposInGrid))
+ dN[(TotposInGrid)] <- as.numeric(simMod at data@original.data[TotposInGrid,Kern at variable.Integral@var.dx]
+ -simMod at data@original.data[TotposInGrid-1,Kern at variable.Integral@var.dx])
+ }else{
+
+ }
+ for(i in c(2:(TotposInGrid))){
+ posInGrid <- i
+ LastTime <- samp at grid[[1]][(posInGrid)]
+ LastStime <- samp at grid[[1]][c(1:(posInGrid-1))]
+ assign(Model at time.variable, LastTime, envir = my.env)
+ assign(Kern at variable.Integral@var.time, LastStime, envir = my.env)
+ assign(paste0("d",Kern at variable.Integral@var.dx), dN[c(1:posInGrid)], envir =my.env)
+ dummyLambda[i] <- eval(ExprHaz[[1]], envir=my.env)
+ }
+
+
+ Solvelambda1 <- -log(cost)-sum(dummyLambda)
+ TotposInGridFin <- TotposInGrid-1
+
+ if(Solvelambda1*SolvelambdaOld < 0){
+
+ dummyLambda <- numeric(length=(TotposInGridFin-1))
+ if(length(Kern at variable.Integral@var.dx)==1){
+ dN <- rep(0, (TotposInGridFin))
+ dN[(TotposInGridFin)] <- as.numeric(simMod at data@original.data[TotposInGridFin,Kern at variable.Integral@var.dx]
+ -simMod at data@original.data[TotposInGridFin-1,Kern at variable.Integral@var.dx])
+ }else{
+
+ }
+ for(i in c(2:(TotposInGridFin))){
+ posInGrid <- i
+ LastTime <- samp at grid[[1]][(posInGrid)]
+ LastStime <- samp at grid[[1]][c(1:(posInGrid-1))]
+ assign(Model at time.variable, LastTime, envir = my.env)
+ assign(Kern at variable.Integral@var.time, LastStime, envir = my.env)
+ assign(paste0("d",Kern at variable.Integral@var.dx), dN[c(1:posInGrid)], envir =my.env)
+ dummyLambda[i] <- eval(ExprHaz[[1]], envir=my.env)
+ }
+
+
+ Solvelambda2 <- -log(cost)-sum(dummyLambda)
+ if(Solvelambda2*Solvelambda1<0){
+ exit <- TRUE
+ Time <- c(Time,my.env$t)
+ IntensityProc<- c(IntensityProc,tail(dummyLambda,n=1L))
+ }else{
+ TotposInGrid <- floor((TotposInGrid-TopposInGridInOld)/2)
+ #repeat
+ }
+ }
+ if(Solvelambda1 == 0){
+ exit <- TRUE
+ Time <- c(Time, my.env$t)
+ }
+ if(Solvelambda1*Solvelambda0>0){
+ TotposInGridFin <- TotposInGrid+1
+ dummyLambda <- numeric(length=(TotposInGridFin-1))
+ if(length(Kern at variable.Integral@var.dx)==1){
+ dN <- rep(0, (TotposInGridFin))
+ dN[(TotposInGridFin)] <- as.numeric(simMod at data@original.data[TotposInGridFin,Kern at variable.Integral@var.dx]
+ -simMod at data@original.data[TotposInGridFin-1,Kern at variable.Integral@var.dx])
+ }else{
+
+ }
+ for(i in c(2:(TotposInGridFin))){
+ posInGrid <- i
+ LastTime <- samp at grid[[1]][(posInGrid)]
+ LastStime <- samp at grid[[1]][c(1:(posInGrid-1))]
+ assign(Model at time.variable, LastTime, envir = my.env)
+ assign(Kern at variable.Integral@var.time, LastStime, envir = my.env)
+ assign(paste0("d",Kern at variable.Integral@var.dx), dN[c(1:posInGrid)], envir =my.env)
+ dummyLambda[i] <- eval(ExprHaz[[1]], envir=my.env)
+ }
+ Solvelambda2 <- -log(cost)-sum(dummyLambda)
+ if(Solvelambda2*Solvelambda1<0){
+ exit <- TRUE
+ Time <- c(Time,my.env$t)
+ }else{
+ TotposInGrid <- TotposInGrid+floor((samp at n-TotposInGrid)/2)
+ }
+ }
+
+ while(Loop){
+ CostDum <- log(runif(1))
+
+ Loop <- FALSE
+ }
+
+ }else{
+
+ }
+
+ # samp <- sampling
+ # Model <- object at model
+ # gFun <- object at gFun
+ # Kern
+
+ # Construction of an expression that is a mathematical
+ # description of the intensity process
+
+ }
}
return(NULL)
}
More information about the Yuima-commits
mailing list