[Yuima-commits] r656 - pkg/yuima/R
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Fri Jun 8 11:17:58 CEST 2018
Author: lorenzo
Date: 2018-06-08 11:17:58 +0200 (Fri, 08 Jun 2018)
New Revision: 656
Modified:
pkg/yuima/R/AuxMethodforPPR.R
pkg/yuima/R/lambdaPPR.R
pkg/yuima/R/simulateForPpr.R
Log:
Updated lambdaPPR.R function
Modified: pkg/yuima/R/AuxMethodforPPR.R
===================================================================
--- pkg/yuima/R/AuxMethodforPPR.R 2018-05-31 03:16:05 UTC (rev 655)
+++ pkg/yuima/R/AuxMethodforPPR.R 2018-06-08 09:17:58 UTC (rev 656)
@@ -86,7 +86,7 @@
if(length(yuimaPPR at PPR@counting.var)==1){
Univariate<-TRUE
}
- if(any(!(yuimaPPR at Kernel@variable.Integral at var.dx %in% yuimaPPR at model@solve.variable))){
+ if(any(yuimaPPR at Kernel@variable.Integral at var.dx %in% yuimaPPR at PPR@covariates)){
my.envd2<-new.env()
ExistdX<-TRUE
}else{
@@ -103,12 +103,6 @@
# construction my.envd1
if(ExistdN){
- #CountingVariable
- for(i in c(1:length(yuimaPPR at PPR@counting.var))){
- cond <- yuimaPPR at model@solve.variable %in% yuimaPPR at PPR@counting.var[i]
- dummyData <-unique(yuimaPPR at data@original.data[,cond])[-1]
- assign(yuimaPPR at PPR@counting.var[i], rep(1,length(dummyData)),envir=my.envd1)
- }
# Names expression
assign("NamesIntgra", NamesIntegrandExpr, envir=my.envd1)
#dN
@@ -133,7 +127,15 @@
assign("namedJumpTimeX",namedJumpTimeX, envir = my.envd1)
assign("var.time",yuimaPPR at Kernel@variable.Integral at var.time,envir=my.envd1)
assign("t.time",yuimaPPR at Kernel@variable.Integral at upper.var,envir=my.envd1)
-
+
+ #CountingVariable
+ for(i in c(1:length(yuimaPPR at PPR@counting.var))){
+ cond <- yuimaPPR at model@solve.variable %in% yuimaPPR at PPR@counting.var[i]
+ dummyData <-unique(yuimaPPR at data@original.data[,cond])[-1]
+ assign(yuimaPPR at PPR@counting.var[i], rep(1,length(dummyData)),envir=my.envd1)
+ }
+
+
# Covariates
if(length(yuimaPPR at PPR@covariates)>0){
# Covariates should be identified at jump time
@@ -152,13 +154,46 @@
#Covariate
#CountingVariable
+ # for(i in c(1:length(yuimaPPR at PPR@counting.var))){
+ # cond <- yuimaPPR at model@solve.variable %in% yuimaPPR at PPR@counting.var[i]
+ # dummyData <-yuimaPPR at data@original.data[,cond]
+ # assign(yuimaPPR at PPR@counting.var[i], dummyData,envir=my.envd1)
+ # }
+
+ #Covariate
+ dummyData<-NULL
+ #CountingVariable
for(i in c(1:length(yuimaPPR at PPR@counting.var))){
- cond <- yuimaPPR at model@solve.variable %in% yuimaPPR at PPR@counting.var[i]
- dummyData <-yuimaPPR at data@original.data[,cond]
- assign(yuimaPPR at PPR@counting.var[i], dummyData,envir=my.envd1)
+ cond <- yuimaPPR at model@solve.variable %in% yuimaPPR at PPR@counting.var[i]
+ dummyData <-as.numeric(yuimaPPR at data@original.data[,cond])
+ assign(yuimaPPR at PPR@counting.var[i], dummyData[-length(dummyData)],envir=my.envd2)
}
+ namedX<-NULL
+ namedJumpTimeX<-NULL
+ for(i in c(1:length(yuimaPPR at Kernel@variable.Integral at var.dx))){
+ if(yuimaPPR at Kernel@variable.Integral at var.dx[i] %in% yuimaPPR at PPR@covariates){
+ cond <- yuimaPPR at model@solve.variable %in% yuimaPPR at Kernel@variable.Integral at var.dx[i]
+ namedX<-c(namedX,paste0("d",yuimaPPR at Kernel@variable.Integral at var.dx[i]))
+ namedJumpTimeX <-c(namedJumpTimeX,paste0("JumpTime.d",yuimaPPR at Kernel@variable.Integral at var.dx[i]))
+ dummyData <- diff(as.numeric(yuimaPPR at data@original.data[,cond]))# We consider only Jump
+ #dummyJumpTime <- gridTime[-1][dummyData>0]
+ assign(paste0("d",yuimaPPR at Kernel@variable.Integral at var.dx[i]), dummyData ,envir=my.envd2)
+ assign(paste0("JumpTime.d",yuimaPPR at Kernel@variable.Integral at var.dx[i]), gridTime[-1] ,envir=my.envd2)
+ }
+ }
+
+ assign("namedX",namedX, envir = my.envd2)
+ assign("namedJumpTimeX",namedJumpTimeX, envir = my.envd2)
+ assign("var.time",yuimaPPR at Kernel@variable.Integral at var.time,envir=my.envd2)
+ assign("t.time",yuimaPPR at Kernel@variable.Integral at upper.var,envir=my.envd2)
+
+ for(i in c(1:length(yuimaPPR at PPR@covariates))){
+ cond <- yuimaPPR at model@solve.variable %in% yuimaPPR at PPR@covariates[i]
+ #dummyData <-yuimaPPR at data@original.data[,cond]
+ dummyData <-as.numeric(yuimaPPR at data@original.data[, cond])
+ assign(yuimaPPR at PPR@covariates[i], dummyData[-length(dummyData)],envir=my.envd2)
+ }
-
}else{
assign("KerneldX",NULL,envir=my.envd2)
}
Modified: pkg/yuima/R/lambdaPPR.R
===================================================================
--- pkg/yuima/R/lambdaPPR.R 2018-05-31 03:16:05 UTC (rev 655)
+++ pkg/yuima/R/lambdaPPR.R 2018-06-08 09:17:58 UTC (rev 656)
@@ -89,23 +89,52 @@
InternalKernelFromPPRModel2<-function(Integrand2,Integrand2expr,my.envd1=NULL,my.envd2=NULL,
Univariate=TRUE, ExistdN, ExistdX, gridTime){
if(Univariate){
- if(ExistdN){
+
dimCol<- dim(Integrand2)[2]
NameCol<-colnames(Integrand2)
- assign(my.envd1$t.time,gridTime, envir=my.envd1)
+ if(ExistdN){
+ assign(my.envd1$t.time,gridTime, envir=my.envd1)
+ }
+ if(ExistdX){
+ assign(my.envd2$t.time,gridTime, envir=my.envd2)
+ }
+
IntegralKernel<- 0
for(i in c(1:dimCol)){
# cond <- NameCol[i] %in% my.envd1$NamesIntgra
# assign(my.envd1$var.time, time(my.envd1[[my.envd1$namedX[cond]]]), my.envd1)
# since it is just univariate we don't need a cycle for
- cond <- paste0("JumpTime.",NameCol[i]) %in% my.envd1$namedJumpTimeX
- assign(my.envd1$var.time,my.envd1[[my.envd1$namedJumpTimeX[cond]]],envir=my.envd1)
-
- IntegralKernelDum<- sum(eval(Integrand2expr[cond], envir=my.envd1),na.rm = TRUE)
- IntegralKernel<-IntegralKernel+IntegralKernelDum
+ if(ExistdN){
+ cond <- paste0("JumpTime.",NameCol[i]) %in% my.envd1$namedJumpTimeX
+ if(cond){
+ assign(my.envd1$var.time,my.envd1[[my.envd1$namedJumpTimeX[cond]]],envir=my.envd1)
+ condpos <- NameCol %in% my.envd1$namedX
+ if(any(condpos)){
+ IntegralKernelDum<- sum(eval(Integrand2expr[condpos], envir=my.envd1),na.rm = TRUE)
+ IntegralKernel<-IntegralKernel+IntegralKernelDum
+ }
+ }
+ }
+
+ if(ExistdX){
+ cond <- paste0("JumpTime.",NameCol[i]) %in% my.envd2$namedJumpTimeX
+ if(cond){
+ assign(my.envd2$var.time,my.envd2[[my.envd2$namedJumpTimeX[cond]]],envir=my.envd2)
+ condpos <- NameCol %in% my.envd2$namedX
+ if(any(condpos)){
+ IntegralKernelDum<- sum(eval(Integrand2expr[condpos], envir=my.envd2),na.rm = TRUE)
+ IntegralKernel<-IntegralKernel+IntegralKernelDum
+ }
+ }
+ }
+ # condpos <- NameCol %in% my.envd2$namedX
+ # if(any(condpos)){
+ # IntegralKernelDum<- sum(eval(Integrand2expr[condpos], envir=my.envd2),na.rm = TRUE)
+ # IntegralKernel<-IntegralKernel+IntegralKernelDum
+ # }
# cat("\n", IntegralKernel)
- }
+
}
}else{
@@ -152,17 +181,17 @@
}
- KerneldN<- numeric(length=length(gridTime))
+ Kernel<- numeric(length=length(gridTime))
# for(i in c(1:length(gridTime))){
# KerneldN[i] <- InternalKernelFromPPRModel(Integrand2,Integrand2expr,my.envd1=my.envd1,my.envd2=my.envd2,
# Univariate=Univariate, ExistdN, ExistdX, gridTime=gridTime[i])
# }
- KerneldN <- sapply(X=gridTime,FUN = InternalKernelFromPPRModel2,
+ Kernel <- sapply(X=gridTime,FUN = InternalKernelFromPPRModel2,
Integrand2=Integrand2, Integrand2expr = Integrand2expr,my.envd1=my.envd1,my.envd2=my.envd2,
Univariate=Univariate, ExistdN =ExistdN, ExistdX=ExistdX )
- KerneldCov<- numeric(length=length(gridTime))
+ #KerneldCov<- numeric(length=length(gridTime))
Evalgfun <- internalGfunFromPPRModel(gfun,my.envd3, univariate=Univariate)
- result<-KerneldN+KerneldCov+Evalgfun
+ result<-Kernel+Evalgfun
}
@@ -191,12 +220,20 @@
}
colnames(Integrand2) <- paste0("d",yuimaPPR at Kernel@variable.Integral at var.dx)
NamesIntegrandExpr <- as.character(matrix(colnames(Integrand2), dim(Integrand2)[1],dim(Integrand2)[2], byrow = TRUE))
+ # if(yuimaPPR at Kernel@Integrand at dimIntegrand[2]==1 & yuimaPPR at Kernel@Integrand at dimIntegrand[1]==1)
+ # Integrand2expr<- parse(text=Integrand2)
+ #
+ # if(yuimaPPR at Kernel@Integrand at dimIntegrand[2]>1 & yuimaPPR at Kernel@Integrand at dimIntegrand[1]==1){
+ # dum <- paste0(Integrand2,collapse=" + ")
+ # Integrand2expr <- parse(text=dum)
+ # }
+
Integrand2expr<- parse(text=Integrand2)
-
+
gridTime <- time(yuimaPPR at data@original.data)
yuimaPPR at Kernel@variable.Integral at var.dx
- if(any(yuimaPPR at Kernel@variable.Integral at var.dx %in% yuimaPPR at model@solve.variable)){
+ if(any(yuimaPPR at Kernel@variable.Integral at var.dx %in% yuimaPPR at PPR@counting.var)){
my.envd1<-new.env()
ExistdN<-TRUE
}else{
@@ -206,7 +243,7 @@
if(length(yuimaPPR at PPR@counting.var)==1){
Univariate<-TRUE
}
- if(any(!(yuimaPPR at Kernel@variable.Integral at var.dx %in% yuimaPPR at model@solve.variable))){
+ if(any(yuimaPPR at Kernel@variable.Integral at var.dx %in% yuimaPPR at PPR@covariates)){
my.envd2<-new.env()
ExistdX<-TRUE
}else{
@@ -224,12 +261,12 @@
if(ExistdN){
#CountingVariable
- for(i in c(1:length(yuimaPPR at PPR@counting.var))){
- cond <- yuimaPPR at model@solve.variable %in% yuimaPPR at PPR@counting.var[i]
- condTime <- gridTime %in% my.envd1$JumpTime.dN
- dummyData <- yuimaPPR at data@original.data[condTime,cond]
- assign(yuimaPPR at PPR@counting.var[i], as.numeric(dummyData),envir=my.envd1)
- }
+ # for(i in c(1:length(yuimaPPR at PPR@counting.var))){
+ # cond <- yuimaPPR at model@solve.variable %in% yuimaPPR at PPR@counting.var[i]
+ # condTime <- gridTime %in% my.envd1$JumpTime.dN
+ # dummyData <- yuimaPPR at data@original.data[condTime,cond]
+ # assign(yuimaPPR at PPR@counting.var[i], as.numeric(dummyData),envir=my.envd1)
+ # }
# Names expression
assign("NamesIntgra", NamesIntegrandExpr, envir=my.envd1)
#dN
@@ -256,13 +293,23 @@
assign("var.time",yuimaPPR at Kernel@variable.Integral at var.time,envir=my.envd1)
assign("t.time",yuimaPPR at Kernel@variable.Integral at upper.var,envir=my.envd1)
+ #CountingVariable
+ for(i in c(1:length(yuimaPPR at PPR@counting.var))){
+ cond <- yuimaPPR at model@solve.variable %in% yuimaPPR at PPR@counting.var[i]
+ condTime <- gridTime %in% my.envd1$JumpTime.dN
+
+ dummyData <- yuimaPPR at data@original.data[condTime,cond]
+ assign(yuimaPPR at PPR@counting.var[i], as.numeric(dummyData),envir=my.envd1)
+ }
+
# Covariates
if(length(yuimaPPR at PPR@covariates)>0){
# Covariates should be identified at jump time
# return(NULL)
for(i in c(1:length(yuimaPPR at PPR@covariates))){
cond <- yuimaPPR at model@solve.variable %in% yuimaPPR at PPR@covariates[i]
- dummyData <-yuimaPPR at data@original.data[,cond]
+ #dummyData <-yuimaPPR at data@original.data[,cond]
+ dummyData <-yuimaPPR at data@original.data[condTime, cond]
assign(yuimaPPR at PPR@covariates[i], dummyData,envir=my.envd1)
}
}
@@ -273,15 +320,39 @@
# construction my.envd2
if(ExistdX){
#Covariate
-
+ dummyData<-NULL
#CountingVariable
for(i in c(1:length(yuimaPPR at PPR@counting.var))){
- cond <- yuimaPPR at PPR@counting.var[i] %in% yuimaPPR at model@solve.variable
- dummyData <-yuimaPPR at data@original.data[,cond]
- assign(yuimaPPR at PPR@counting.var[i], dummyData,envir=my.envd1)
+ cond <- yuimaPPR at model@solve.variable %in% yuimaPPR at PPR@counting.var[i]
+ dummyData <-as.numeric(yuimaPPR at data@original.data[,cond])
+ assign(yuimaPPR at PPR@counting.var[i], dummyData[-length(dummyData)],envir=my.envd2)
}
+ namedX<-NULL
+ namedJumpTimeX<-NULL
+ for(i in c(1:length(yuimaPPR at Kernel@variable.Integral at var.dx))){
+ if(yuimaPPR at Kernel@variable.Integral at var.dx[i] %in% yuimaPPR at PPR@covariates){
+ cond <- yuimaPPR at model@solve.variable %in% yuimaPPR at Kernel@variable.Integral at var.dx[i]
+ namedX<-c(namedX,paste0("d",yuimaPPR at Kernel@variable.Integral at var.dx[i]))
+ namedJumpTimeX <-c(namedJumpTimeX,paste0("JumpTime.d",yuimaPPR at Kernel@variable.Integral at var.dx[i]))
+ dummyData <- diff(as.numeric(yuimaPPR at data@original.data[,cond]))# We consider only Jump
+ #dummyJumpTime <- gridTime[-1][dummyData>0]
+ assign(paste0("d",yuimaPPR at Kernel@variable.Integral at var.dx[i]), dummyData ,envir=my.envd2)
+ assign(paste0("JumpTime.d",yuimaPPR at Kernel@variable.Integral at var.dx[i]), gridTime[-1] ,envir=my.envd2)
+ }
+ }
+
+ assign("namedX",namedX, envir = my.envd2)
+ assign("namedJumpTimeX",namedJumpTimeX, envir = my.envd2)
+ assign("var.time",yuimaPPR at Kernel@variable.Integral at var.time,envir=my.envd2)
+ assign("t.time",yuimaPPR at Kernel@variable.Integral at upper.var,envir=my.envd2)
+
+ for(i in c(1:length(yuimaPPR at PPR@covariates))){
+ cond <- yuimaPPR at model@solve.variable %in% yuimaPPR at PPR@covariates[i]
+ #dummyData <-yuimaPPR at data@original.data[,cond]
+ dummyData <-as.numeric(yuimaPPR at data@original.data[, cond])
+ assign(yuimaPPR at PPR@covariates[i], dummyData[-length(dummyData)],envir=my.envd2)
+ }
-
}else{
assign("KerneldX",NULL,envir=my.envd2)
}
Modified: pkg/yuima/R/simulateForPpr.R
===================================================================
--- pkg/yuima/R/simulateForPpr.R 2018-05-31 03:16:05 UTC (rev 655)
+++ pkg/yuima/R/simulateForPpr.R 2018-06-08 09:17:58 UTC (rev 656)
@@ -84,7 +84,7 @@
}
dum.g <- paste("tail(",dum.g,", n=1L)")
- dum.Ker <- as.character(Kern.Fun at Integrand@IntegrandList[[i]])
+ dum.Ker <- as.character(unlist(Kern.Fun at Integrand@IntegrandList))
dum.Ker <- gsub("(", "( ", fixed=TRUE,x = dum.Ker)
dum.Ker <- gsub(")", " )", fixed=TRUE,x = dum.Ker)
@@ -127,13 +127,19 @@
}
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 <- paste("(",dum.Ker, ") * (", cond.Sup, ")")
dum.Ker <- paste0("sum(",dum.Ker,")")
+ if(Kern.Fun at Integrand@dimIntegrand[2]>1 & Kern.Fun at Integrand@dimIntegrand[1]==1){
+ dum.Ker <- paste(dum.Ker,collapse = " + ")
+ }
+ if(Kern.Fun at Integrand@dimIntegrand[1]>1){
+ yuima.stop("Check")
+ }
+ # 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, ")")
+
Int.Intens[[i]] <- parse(text = paste(dum.g, dum.Ker, sep = " + "))
}
res <- list(Intens = Int.Intens)
@@ -273,7 +279,34 @@
Lambda <- eval(ExprHaz[[1]], envir=my.env)
return(Lambda)
}else{
- return(NULL)
+ if(Kern at Integrand@dimIntegrand[1]==1){
+ assign(Kern at variable.Integral@var.time, Time, envir = my.env)
+ # cond <- -log(cost)-sum(dummyLambda)*samp at delta
+
+ assign(Model at time.variable, capitalTime, envir = my.env)
+ for(i in c(1:length(Kern at variable.Integral@var.dx)) ){
+ if(Kern at variable.Integral@var.dx[i]==my.env$info.PPR at counting.var){
+ assign(paste0("d",Kern at variable.Integral@var.dx[i]), dN, envir =my.env)
+ }
+ if(Kern at variable.Integral@var.dx[i]%in%my.env$info.PPR at covariates){
+ assign(paste0("d",Kern at variable.Integral@var.dx[i]),
+ diff(c(0,my.env[[Kern at variable.Integral@var.dx[i]]])) ,
+ envir =my.env)
+ }
+ if(Kern at variable.Integral@var.dx[i]%in%my.env$info.PPR at var.dt){
+ assign(paste0("d",Kern at variable.Integral@var.dx[i]),
+ diff(c(0,my.env[[Kern at variable.Integral@var.dx[i]]])) ,
+ envir =my.env)
+ }
+ }
+ condPointIngrid <- simMod at sampling@grid[[1]]<=my.env$t
+ PointIngridInt <- simMod at sampling@grid[[1]][condPointIngrid]
+ CondJumpGrid <- PointIngridInt %in% my.env$s
+ assign("CondJumpGrid", CondJumpGrid, envir = my.env)
+
+ Lambda <- eval(ExprHaz[[1]], envir=my.env)
+ return(Lambda)
+ }
}
}
@@ -443,6 +476,9 @@
Time <- samp at Initial
my.env <- new.env()
+
+ assign("info.PPR", object at PPR, my.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]]),
More information about the Yuima-commits
mailing list