[Yuima-commits] r506 - in pkg/yuima: . R man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Wed Nov 2 12:58:17 CET 2016
Author: lorenzo
Date: 2016-11-02 12:58:16 +0100 (Wed, 02 Nov 2016)
New Revision: 506
Modified:
pkg/yuima/DESCRIPTION
pkg/yuima/R/PointProcessClasses.R
pkg/yuima/R/setPpr.R
pkg/yuima/R/simulateForPpr.R
pkg/yuima/man/setPpr.Rd
Log:
Modified: pkg/yuima/DESCRIPTION
===================================================================
--- pkg/yuima/DESCRIPTION 2016-11-02 10:28:02 UTC (rev 505)
+++ pkg/yuima/DESCRIPTION 2016-11-02 11:58:16 UTC (rev 506)
@@ -1,7 +1,7 @@
Package: yuima
Type: Package
Title: The YUIMA Project Package for SDEs
-Version: 1.3.2
+Version: 1.3.3
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/PointProcessClasses.R
===================================================================
--- pkg/yuima/R/PointProcessClasses.R 2016-11-02 10:28:02 UTC (rev 505)
+++ pkg/yuima/R/PointProcessClasses.R 2016-11-02 11:58:16 UTC (rev 506)
@@ -9,7 +9,9 @@
covariates = "character",
var.dt = "character",
additional.info = "character",
- Info.measure = "list")
+ Info.measure = "list",
+ RegressWithCount = "logical",
+ IntensWithCount = "logical")
)
setClass("yuima.Ppr",
@@ -32,7 +34,9 @@
covariates = character(),
var.dt = character(),
additional.info = character(),
- Info.measure = list()){
+ Info.measure = list(),
+ RegressWithCount = FALSE,
+ IntensWithCount = TRUE){
.Object at allparam <- allparam
.Object at allparamPpr <- allparamPpr
.Object at common <- common
@@ -44,6 +48,8 @@
.Object at var.dt <- var.dt
.Object at additional.info <- additional.info
.Object at Info.measure <- Info.measure
+ .Object at RegressWithCount <- RegressWithCount
+ .Object at IntensWithCount <- IntensWithCount
return(.Object)
}
)
Modified: pkg/yuima/R/setPpr.R
===================================================================
--- pkg/yuima/R/setPpr.R 2016-11-02 10:28:02 UTC (rev 505)
+++ pkg/yuima/R/setPpr.R 2016-11-02 11:58:16 UTC (rev 506)
@@ -1,5 +1,5 @@
setPpr <- function(yuima, counting.var="N", gFun, Kernel,
- var.dx, var.dt = "s", lambda.var = "lambda",
+ var.dx= "s", var.dt = "s", lambda.var = "lambda",
lower.var="0", upper.var = "t",
nrow =1 ,ncol=1){
@@ -74,10 +74,65 @@
}else{
measure <- yuima at measure
}
+ IntensWithCount<-FALSE
+ if(!is.list(g at Output@formula)){
+ if(any(counting.var%in%all.vars(g at Output@formula)))
+ IntensWithCount<-TRUE
+ }else{
+ ddd<- length(g at Output@formula)
+ for(i in c(1:ddd)){
+ if(any(counting.var%in%all.vars(g at Output@formula[[i]])))
+ IntensWithCount<-TRUE
+ }
+ }
+ if(any(counting.var%in%Integral at Integral@variable.Integral at var.dx))
+ IntensWithCount<-TRUE
+
+ if(!is.list(Integral at Integral@Integrand at IntegrandList)){
+ if(any(counting.var%in%all.vars(Integral at Integral@Integrand at IntegrandList)))
+ IntensWithCount<-TRUE
+ }else{
+ ddd<- length(Integral at Integral@Integrand at IntegrandList)
+ for(i in c(1:ddd)){
+ if(any(counting.var%in%all.vars(Integral at Integral@Integrand at IntegrandList[[i]])))
+ IntensWithCount<-TRUE
+ }
+ }
+
+ RegressWithCount <- FALSE
+
if(general){
covariates<-character()
if(sum(!(counting.var==yuima at solve.variable))!=0){
- covariates<-yuima at solve.variable[!(counting.var==yuima at solve.variable)]
+ condCovariate<-!(counting.var==yuima at solve.variable)
+ covariates<-yuima at solve.variable[condCovariate]
+ if(length(covariates)>0){
+ covariate.drift <- yuima at drift[condCovariate]
+ covariate.diff <- yuima at diffusion[condCovariate]
+ covariate.jump <- yuima at jump.coeff[condCovariate]
+ }
+ if(any(counting.var %in% all.vars(covariate.drift))){
+ RegressWithCount <-TRUE
+ }
+
+ ddd.dif <-length(covariate.diff)
+ if(length(covariate.diff)>0){
+ for(i in c(1:ddd.dif)){
+ if(any(counting.var %in% all.vars(covariate.diff[[i]]))){
+ RegressWithCount <-TRUE
+ }
+ }
+ }
+
+ ddd.jump <-length(covariate.jump)
+ if(length(covariate.jump)>0){
+ for(i in c(1:ddd.jump)){
+ if(any(counting.var %in% all.vars(covariate.jump[[i]]))){
+ RegressWithCount <-TRUE
+ }
+ }
+ }
+
}
Ppr <- new("info.Ppr",
allparam = paramHawkes$allparam,
@@ -90,7 +145,9 @@
covariates = covariates,
var.dt = var.dt,
additional.info = lambda.var,
- Info.measure = list(type=type,measure=measure))
+ Info.measure = list(type=type,measure=measure),
+ RegressWithCount=RegressWithCount,
+ IntensWithCount=IntensWithCount)
ret <- new("yuima.Ppr", Ppr = Ppr,
Modified: pkg/yuima/R/simulateForPpr.R
===================================================================
--- pkg/yuima/R/simulateForPpr.R 2016-11-02 10:28:02 UTC (rev 505)
+++ pkg/yuima/R/simulateForPpr.R 2016-11-02 11:58:16 UTC (rev 506)
@@ -51,7 +51,7 @@
increment.L = increment.L, method = method, hurst = hurst,
methodfGn = methodfGn, sampling = sampling,
subsampling = subsampling){
- ROLDVER<-TRUE
+ ROLDVER<-!(is(object at model@measure$df,"yuima.law"))
if(ROLDVER){
object <- aux.simulatPprROldVersion(object, nsim = nsim, seed = seed,
xinit = xinit, true.parameter = true.parameter,
@@ -73,28 +73,122 @@
aux.simulatPprROldNew<-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,
+ increment.L = increment.L, method = method, hurst = 0.5,
methodfGn = methodfGn, sampling = sampling,
subsampling = subsampling){
# We need an expression for the evaluation of the hazard
- is(object)
- yuimaPpr<-object
+ if(missing(hurst)){
+ hurst<-0.5
+ }
+ samp <- sampling
+ Model <- object at model
+ gFun <- object at gFun
+ Kern <- object at Kernel
- envPpr <- list()
+ if(missing(xinit)){
+ if(object at Ppr@RegressWithCount){
- dY <- paste0("d",yuimaPpr at Ppr@var.dx)
- Time <- sampling at grid[[1]]
-
- IntKernExpr<- function(Kern,dy){
- dum<-paste(Kern,dy,sep="*")
- dum<-paste0(dum, collapse = " + ")
- dum <- paste0("sum( ", dum, " )")
- return(parse(text = dum))
+ yuima.warn("Counting Variables are also covariates.
+ In this case, the algorthim will be implemented
+ as soon as possible.")
+ return(NULL)
+ }
+ }else{
+ if(object at Ppr@RegressWithCount){
+ yuima.warn("Counting Variables are also covariates.
+ In this case, the algorthim will be implemented
+ as soon as possible.")
+ return(NULL)
+ }
}
- IntegKern <- lapply(yuimaPpr at Kernel@Integrand at IntegrandList,IntKernExpr,dY)
+ if(!object at Ppr@RegressWithCount && !object at Ppr@IntensWithCount){
+ auxg <- setMap(func = gFun at formula, yuima =Model)
+ dummyKernIntgrand <- Kern at Integrand@IntegrandList
+ dummyUpperTime<- paste0(Kern at variable.Integral@upper.var,
+ Kern at variable.Integral@upper.var,
+ collapse = "")
+ dummyTime <-Model at time.variable
+ for(i in c(1:length(dummyKernIntgrand))){
+ if(Kern at variable.Integral@upper.var %in% all.vars(dummyKernIntgrand[[i]])){
+ dumExpr <- paste0("substitute(expression(",
+ dummyKernIntgrand[[i]],"), list(",
+ Kern at variable.Integral@upper.var,
+ " = as.symbol(dummyUpperTime), ",
+ Kern at variable.Integral@var.time,
+ " = as.symbol(Model at time.variable)))")
+ dummyKernIntgrand[[i]] <- eval(parse(text=dumExpr))
+ }
+ }
+ auxIntMy <- unlist(lapply(dummyKernIntgrand, FUN = function(X){as.character(X)[2]}))
+ auxIntMy <- matrix(auxIntMy, Kern at Integrand@dimIntegrand[1],
+ Kern at Integrand@dimIntegrand[2], byrow=T)
+
+ auxInt <- setIntegral(yuima = Model,
+ integrand = auxIntMy,
+ var.dx = Model at time.variable,
+ upper.var = dummyUpperTime,
+ lower.var = Kern at variable.Integral@lower.var)
+ 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.L <- t(rand(object = randomGenerator, n=NumbIncr, param=measureparam))
+ Noise.W <- t(rnorm(NumbIncr, 0,tForMeas))
+ if(missing(xinit)){
+ simg <- simulate(object = auxg, true.parameter = true.parameter[auxg at Output@param at allparam],
+ sampling = samp, hurst = hurst,
+ increment.W = Noise.W, increment.L = Noise.L)
+ simK <- simulate(object = auxInt, true.parameter = true.parameter[auxInt at Integral@param.Integral at allparam],
+ sampling = samp, hurst = hurst,
+ increment.W = Noise.W,
+ increment.L = Noise.L)
+ Lambda.data <- simg at data@original.data+simK at data@original.data
+ Pos<-0
+ globPos<-Pos
+ condWhile <- TRUE
+ while(condWhile){
+ Hazard<--cumsum(as.numeric(Lambda.data)[c(Pos:(samp at n+1))])*samp at delta
+ U<-runif(1)
+ CondPos <- log(U)<=Hazard
+ Pos <- Pos+sum(CondPos)
+ if(Pos > (samp at n+1)){
+ condWhile <- FALSE
+ }else{
+ globPos <- c(globPos,Pos)
+ }
+ }
+ NewNoise.L <- Noise.L
+ cod <- object at Ppr@counting.var%in%Model at solve.variable
+ NeWNoise.W<-Noise.W
+ NeWNoise.W[cod,] <- 0
+ NewNoise.L[cod,] <- 0
+ NewNoise.L[cod,globPos[-1]] <- Noise.L[cod,globPos[-1]]
+ simM <- simulate(object = Model, true.parameter = true.parameter[Model at parameter@all],
+ sampling = samp, hurst = hurst,
+ increment.W = NeWNoise.W,
+ increment.L = NewNoise.L)
+ object at data <- simM at data
+ object at sampling <- samp
+ return(object)
+ #Lambda.data <- simg at data@original.data+simK at data@original.data
+ }else{
+ simg <- simulate(object = auxg, xinit=xinit,
+ sampling = samp)
+ }
+ }
+ }
return(NULL)
}
Modified: pkg/yuima/man/setPpr.Rd
===================================================================
--- pkg/yuima/man/setPpr.Rd 2016-11-02 10:28:02 UTC (rev 505)
+++ pkg/yuima/man/setPpr.Rd 2016-11-02 11:58:16 UTC (rev 506)
@@ -5,7 +5,7 @@
\description{Constructor of a Point Process }
\usage{
setPpr(yuima, counting.var = "N", gFun, Kernel,
- var.dx, var.dt = "s", lambda.var = "lambda",
+ var.dx = "s", var.dt = "s", lambda.var = "lambda",
lower.var = "0", upper.var = "t", nrow = 1, ncol = 1)
}
%- maybe also 'usage' for other objects documented here.
More information about the Yuima-commits
mailing list