[Yuima-commits] r578 - pkg/yuima/R

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Mon Jan 23 10:40:08 CET 2017


Author: lorenzo
Date: 2017-01-23 10:40:08 +0100 (Mon, 23 Jan 2017)
New Revision: 578

Modified:
   pkg/yuima/R/AuxMethodforPPR.R
   pkg/yuima/R/lambdaPPR.R
   pkg/yuima/R/yuima.model.R
Log:


Modified: pkg/yuima/R/AuxMethodforPPR.R
===================================================================
--- pkg/yuima/R/AuxMethodforPPR.R	2017-01-23 08:01:57 UTC (rev 577)
+++ pkg/yuima/R/AuxMethodforPPR.R	2017-01-23 09:40:08 UTC (rev 578)
@@ -6,17 +6,27 @@
                                my.envd2=NULL,my.envd3=NULL){
   param<-unlist(param)
 
-  IntLambda<-InternalConstractionIntensity(param,my.envd1,
+  IntLambda<-InternalConstractionIntensity2(param,my.envd1,
                                            my.envd2,my.envd3)
+
+  # IntLambda<-InternalConstractionIntensity(param,my.envd1,
+  #                                          my.envd2,my.envd3)
   Index<-my.envd3$gridTime
-  Integr1 <- -sum(IntLambda[-length(IntLambda)]*diff(Index))
+  Integr1 <- -sum(IntLambda[-length(IntLambda)]*diff(Index),na.rm=TRUE)
+  # if(is.nan(Integr1)){
+  #   Integr1 <- -10^6
+  # }
   cond2 <- diff(as.numeric(my.envd3$YUIMA.PPR at data@original.data))
-  Integr2<- sum(log(IntLambda[-1][cond2>0]))
+  Integr2<- sum(log(IntLambda[-1][cond2>0]),na.rm=TRUE)
+  # if(is.nan(Integr2)){
+  #   Integr2 <- -10^6
+  # }
   logLik <- Integr1+Integr2
-  cat("\n ",logLik)
+  cat("\n ",logLik, param)
   return(-logLik)
 }
 
+
 quasiLogLik.Ppr <- function(yuimaPpr, parLambda=list(), method=method, fixed = list(),
                             lower, upper, call, ...){
 
@@ -24,6 +34,8 @@
   parLambda->param
   gfun<-yuimaPPr at gFun@formula
 
+  gfun<-yuimaPPr at gFun@formula
+
   dimIntegr <- length(yuimaPPr at Kernel@Integrand at IntegrandList)
   Integrand2 <- character(length=dimIntegr)
   for(i in c(1:dimIntegr)){
@@ -82,18 +94,24 @@
     assign("NamesIntgra", NamesIntegrandExpr, envir=my.envd1)
     #dN
     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@counting.var){
         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]
         dummyData2 <- diff(unique(cumsum(dummyData)))
-        dummyData3 <- zoo(dummyData2,order.by = dummyJumpTime)
+        #dummyData3 <- zoo(dummyData2,order.by = dummyJumpTime)
+        dummyData3 <- dummyData2
+        JumpTime <- dummyJumpTime
         assign(paste0("d",yuimaPPr at Kernel@variable.Integral at var.dx[i]), dummyData3 ,envir=my.envd1)
+        assign(paste0("JumpTime.d",yuimaPPr at Kernel@variable.Integral at var.dx[i]), dummyJumpTime ,envir=my.envd1)
       }
     }
     assign("namedX",namedX, envir = my.envd1)
+    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)
 
@@ -144,10 +162,13 @@
   assign("Integrand2",Integrand2,envir=my.envd3)
   assign("Integrand2expr",Integrand2expr,envir=my.envd3)
 
-  assign("gridTime",gridTime,envir=my.envd3)
+  assign("gridTime",as.numeric(gridTime),envir=my.envd3)
   assign("Univariate",Univariate,envir=my.envd3)
   assign("ExistdN",ExistdN,envir=my.envd3)
   assign("ExistdX",ExistdX,envir=my.envd3)
+
+
+
   out<-NULL
 
   if(length(lower)==0 && length(upper)>0 && length(fixed)==0){
@@ -213,6 +234,202 @@
 }
 
 
+# quasiLogLik.Ppr <- function(yuimaPpr, parLambda=list(), method=method, fixed = list(),
+#                             lower, upper, call, ...){
+#
+#   yuimaPpr->yuimaPPr
+#   parLambda->param
+#   gfun<-yuimaPPr at gFun@formula
+#
+#   dimIntegr <- length(yuimaPPr at Kernel@Integrand at IntegrandList)
+#   Integrand2 <- character(length=dimIntegr)
+#   for(i in c(1:dimIntegr)){
+#     Integrand1 <- as.character(yuimaPPr at Kernel@Integrand at IntegrandList[[i]])
+#     timeCond <- paste0(" * (",yuimaPPr at Kernel@variable.Integral at var.time," < ",yuimaPPr at Kernel@variable.Integral at upper.var,")")
+#     Integrand2[i] <-paste0(Integrand1,timeCond)
+#   }
+#
+#   Integrand2<- matrix(Integrand2,yuimaPPr at Kernel@Integrand at dimIntegrand[1],yuimaPPr at Kernel@Integrand at dimIntegrand[2])
+#
+#
+#   for(j in c(1:yuimaPPr at Kernel@Integrand at dimIntegrand[2])){
+#     Integrand2[,j]<-paste0(Integrand2[,j]," * d",yuimaPPr at Kernel@variable.Integral at var.dx[j])
+#   }
+#   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))
+#   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)){
+#     my.envd1<-new.env()
+#     ExistdN<-TRUE
+#   }else{
+#     ExistdN<-FALSE
+#   }
+#   Univariate<-FALSE
+#   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))){
+#     my.envd2<-new.env()
+#     ExistdX<-TRUE
+#   }else{
+#     my.envd2<-new.env()
+#     ExistdX<-FALSE
+#   }
+#
+#   my.envd3 <- new.env()
+#   namesparam<-names(param)
+#   if(!(all(namesparam %in% yuimaPPr at Ppr@allparamPpr) && length(namesparam)==length(yuimaPPr at Ppr@allparamPpr))){
+#     return(NULL)
+#   }
+#
+#   # construction my.envd1
+#   if(ExistdN){
+#
+#     #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 <-unique(yuimaPPr at data@original.data[,cond])[-1]
+#       assign(yuimaPPr at Ppr@counting.var[i], dummyData,envir=my.envd1)
+#     }
+#     # Names expression
+#     assign("NamesIntgra", NamesIntegrandExpr, envir=my.envd1)
+#     #dN
+#     namedX <-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@counting.var){
+#         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]))
+#         dummyData <- diff(as.numeric(yuimaPPr at data@original.data[,cond]))# We consider only Jump
+#         dummyJumpTime <- gridTime[-1][dummyData>0]
+#         dummyData2 <- diff(unique(cumsum(dummyData)))
+#         dummyData3 <- zoo(dummyData2,order.by = dummyJumpTime)
+#         assign(paste0("d",yuimaPPr at Kernel@variable.Integral at var.dx[i]), dummyData3 ,envir=my.envd1)
+#       }
+#     }
+#     assign("namedX",namedX, 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)
+#
+#     # Covariates
+#     if(length(yuimaPPr at Ppr@covariates)>1){
+#       # Covariates should be identified at jump time
+#       return(NULL)
+#     }
+#
+#   }
+#   # end coonstruction my.envd1
+#
+#   # construction my.envd2
+#   if(ExistdX){
+#     #Covariate
+#
+#     #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)
+#     }
+#
+#
+#   }else{
+#     assign("KerneldX",NULL,envir=my.envd2)
+#   }
+#
+#   # end construction my.envd2
+#
+#   # construction my.envd3
+#
+#   #Covariate
+#
+#   #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.envd3)
+#   }
+#   #time
+#   assign(yuimaPPr at model@time.variable, gridTime, my.envd3)
+#
+#   #Model
+#   assign("YUIMA.PPR",yuimaPPr,envir=my.envd3)
+#   assign("namesparam",namesparam,envir=my.envd3)
+#   assign("gfun",gfun,envir=my.envd3)
+#   assign("Integrand2",Integrand2,envir=my.envd3)
+#   assign("Integrand2expr",Integrand2expr,envir=my.envd3)
+#
+#   assign("gridTime",gridTime,envir=my.envd3)
+#   assign("Univariate",Univariate,envir=my.envd3)
+#   assign("ExistdN",ExistdN,envir=my.envd3)
+#   assign("ExistdX",ExistdX,envir=my.envd3)
+#   out<-NULL
+#
+#   if(length(lower)==0 && length(upper)>0 && length(fixed)==0){
+#     out <- optim(par=param, fn=Internal.LogLikPPR,
+#                  my.envd1=my.envd1,my.envd2=my.envd2,my.envd3=my.envd3,
+#                  method = method, upper=upper, ...)
+#
+#   }
+#
+#   if(length(lower)==0 && length(upper)==0 && length(fixed)>0){
+#     out <- optim(par=param, fn=Internal.LogLikPPR,
+#                  my.envd1=my.envd1,my.envd2=my.envd2,my.envd3=my.envd3,
+#                  method = method, fixed = fixed, ...)
+#
+#   }
+#
+#
+#   if(length(lower)>0 && length(upper)==0 && length(fixed)==0){
+#     out <- optim(par = param,  fn=Internal.LogLikPPR,
+#                  my.envd1=my.envd1,my.envd2=my.envd2,my.envd3=my.envd3,
+#                  method = method, lower=lower, ...)
+#   }
+#
+#   if(length(lower)>0 && length(upper)>0 && length(fixed)==0){
+#     out <- optim(par=param, fn=Internal.LogLikPPR,
+#                  my.envd1=my.envd1,my.envd2=my.envd2,my.envd3=my.envd3,
+#                  method = method, upper = upper,
+#                  lower=lower, ...)
+#   }
+#
+#
+#   if(length(lower)==0 && length(upper)>0 && length(fixed)>0){
+#     out <- optim(par=param, fn=Internal.LogLikPPR,
+#                  my.envd1=my.envd1,my.envd2=my.envd2,my.envd3=my.envd3,
+#                  method = method, upper = upper,
+#                  fixed = fixed,  ...)
+#   }
+#
+#   if(length(lower)>0 && length(upper)==0 && length(fixed)>0){
+#     out <- optim(par=param, fn=Internal.LogLikPPR,
+#                  my.envd1=my.envd1,my.envd2=my.envd2,my.envd3=my.envd3,
+#                  method = method, lower = lower,
+#                  fixed = fixed, ...)
+#   }
+#
+#
+#   if(length(lower)>0 && length(upper)>0 && length(fixed)>0){
+#     out <- optim(par=param, fn=Internal.LogLikPPR,
+#                  my.envd1=my.envd1,my.envd2=my.envd2,my.envd3=my.envd3,
+#                  method = method, lower = lower, fixed = fixed, upper = upper, ...)
+#   }
+#
+#
+#   if(is.null(out)){
+#     out <- optim(par=param, fn=Internal.LogLikPPR,
+#                  my.envd1=my.envd1,my.envd2=my.envd2,my.envd3=my.envd3,
+#                  method = method, ...)
+#   }
+#
+#
+#   return(out)
+#
+# }
+
+
 lambdaFromData <- function(yuimaPpr, PprData=NULL, parLambda=list()){
  if(is.null(PprData)){
    PprData<-yuimaPpr at data

Modified: pkg/yuima/R/lambdaPPR.R
===================================================================
--- pkg/yuima/R/lambdaPPR.R	2017-01-23 08:01:57 UTC (rev 577)
+++ pkg/yuima/R/lambdaPPR.R	2017-01-23 09:40:08 UTC (rev 578)
@@ -76,12 +76,97 @@
     KerneldN[i] <- InternalKernelFromPPrModel(Integrand2,Integrand2expr,my.envd1=my.envd1,my.envd2=my.envd2,
                                               Univariate=Univariate, ExistdN, ExistdX, gridTime=gridTime[i])
   }
+  # KerneldN <- sapply(X=as.numeric(gridTime),FUN = InternalKernelFromPPrModel,
+  #        Integrand2=Integrand2, Integrand2expr = Integrand2expr,my.envd1=my.envd1,my.envd2=my.envd2,
+  #        Univariate=Univariate, ExistdN =ExistdN, ExistdX=ExistdX )
   KerneldCov<- numeric(length=length(gridTime))
   Evalgfun <- internalGfunFromPPrModel(gfun,my.envd3, univariate=Univariate)
   result<-KerneldN+KerneldCov+Evalgfun
 
 }
 
+
+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)
+      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))
+        IntegralKernel<-IntegralKernel+IntegralKernelDum
+        #       cat("\n", IntegralKernel)
+      }
+    }
+
+  }else{
+    return(NULL)
+  }
+
+  return(IntegralKernel)
+}
+
+
+InternalConstractionIntensity2<-function(param,my.envd1=NULL,
+                                         my.envd2=NULL,my.envd3=NULL){
+  paramPPr <- my.envd3$YUIMA.PPR at Ppr@allparamPpr
+  namesparam <-my.envd3$namesparam
+
+
+  gridTime  <-my.envd3$gridTime
+  Univariate <-my.envd3$Univariate
+  ExistdN <-my.envd3$ExistdN
+  ExistdX <-my.envd3$ExistdX
+
+  gfun<-my.envd3$gfun
+  Integrand2<-my.envd3$Integrand2
+  Integrand2expr<-my.envd3$Integrand2expr
+
+  if(ExistdN){
+    for(i in c(1:length(paramPPr))){
+      cond<-namesparam %in% paramPPr[i]
+      assign(paramPPr[i], param[cond], envir = my.envd1 )
+    }
+  }
+
+  if(ExistdX){
+    for(i in c(1:length(paramPPr))){
+      cond<-namesparam %in% paramPPr[i]
+      assign(paramPPr[i], param[cond], envir = my.envd2)
+    }
+  }
+
+  #param
+  for(i in c(1:length(paramPPr))){
+    cond<-namesparam %in% paramPPr[i]
+    assign(paramPPr[i], param[cond], envir = my.envd3)
+  }
+
+
+  KerneldN<- 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,
+                     Integrand2=Integrand2, Integrand2expr = Integrand2expr,my.envd1=my.envd1,my.envd2=my.envd2,
+                     Univariate=Univariate, ExistdN =ExistdN, ExistdX=ExistdX )
+  KerneldCov<- numeric(length=length(gridTime))
+  Evalgfun <- internalGfunFromPPrModel(gfun,my.envd3, univariate=Univariate)
+  result<-KerneldN+KerneldCov+Evalgfun
+
+}
+
+
 Intensity.PPR <- function(yuimaPPr,param){
   # I need three envirnment
   # 1. my.envd1 is used when the counting variable is integrator
@@ -148,18 +233,24 @@
     assign("NamesIntgra", NamesIntegrandExpr, envir=my.envd1)
     #dN
     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@counting.var){
         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]
         dummyData2 <- diff(unique(cumsum(dummyData)))
-        dummyData3 <- zoo(dummyData2,order.by = dummyJumpTime)
+        #dummyData3 <- zoo(dummyData2,order.by = dummyJumpTime)
+        dummyData3 <- dummyData2
+        JumpTime <- dummyJumpTime
         assign(paste0("d",yuimaPPr at Kernel@variable.Integral at var.dx[i]), dummyData3 ,envir=my.envd1)
+        assign(paste0("JumpTime.d",yuimaPPr at Kernel@variable.Integral at var.dx[i]), dummyJumpTime ,envir=my.envd1)
       }
     }
     assign("namedX",namedX, envir = my.envd1)
+    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)
 
@@ -210,7 +301,7 @@
   assign("Integrand2",Integrand2,envir=my.envd3)
   assign("Integrand2expr",Integrand2expr,envir=my.envd3)
 
-  assign("gridTime",gridTime,envir=my.envd3)
+  assign("gridTime",as.numeric(gridTime),envir=my.envd3)
   assign("Univariate",Univariate,envir=my.envd3)
   assign("ExistdN",ExistdN,envir=my.envd3)
   assign("ExistdX",ExistdX,envir=my.envd3)
@@ -222,16 +313,14 @@
 
 
 
-################################
-# Start Intensity construction #
-################################
+  ################################
+  # Start Intensity construction #
+  ################################
   #We define the parameters value for each environment
 
   param<-unlist(param)
-
-  result<-InternalConstractionIntensity(param,my.envd1,
-                                        my.envd2,my.envd3)
-
+  result<-InternalConstractionIntensity2(param,my.envd1,
+                                           my.envd2,my.envd3)
   Int2<-zoo(as.matrix(result),order.by = gridTime)
   colnames(Int2)<-"lambda"
   res<-setData(Int2)
@@ -239,3 +328,165 @@
 
 
 }
+
+
+
+
+
+# Intensity.PPR <- function(yuimaPPr,param){
+#   # I need three envirnment
+#   # 1. my.envd1 is used when the counting variable is integrator
+#   # 2. my.envd2 is used when covariates or time are integrator
+#   # 3. my.envd3 for gfun
+#
+#   gfun<-yuimaPPr at gFun@formula
+#
+#   dimIntegr <- length(yuimaPPr at Kernel@Integrand at IntegrandList)
+#   Integrand2 <- character(length=dimIntegr)
+#   for(i in c(1:dimIntegr)){
+#     Integrand1 <- as.character(yuimaPPr at Kernel@Integrand at IntegrandList[[i]])
+#     timeCond <- paste0(" * (",yuimaPPr at Kernel@variable.Integral at var.time," < ",yuimaPPr at Kernel@variable.Integral at upper.var,")")
+#     Integrand2[i] <-paste0(Integrand1,timeCond)
+#   }
+#
+#   Integrand2<- matrix(Integrand2,yuimaPPr at Kernel@Integrand at dimIntegrand[1],yuimaPPr at Kernel@Integrand at dimIntegrand[2])
+#
+#
+#   for(j in c(1:yuimaPPr at Kernel@Integrand at dimIntegrand[2])){
+#     Integrand2[,j]<-paste0(Integrand2[,j]," * d",yuimaPPr at Kernel@variable.Integral at var.dx[j])
+#   }
+#   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))
+#   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)){
+#     my.envd1<-new.env()
+#     ExistdN<-TRUE
+#   }else{
+#     ExistdN<-FALSE
+#   }
+#   Univariate<-FALSE
+#   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))){
+#     my.envd2<-new.env()
+#     ExistdX<-TRUE
+#   }else{
+#     my.envd2<-new.env()
+#     ExistdX<-FALSE
+#   }
+#
+#   my.envd3 <- new.env()
+#   namesparam<-names(param)
+#   if(!(all(namesparam %in% yuimaPPr at Ppr@allparamPpr) && length(namesparam)==length(yuimaPPr at Ppr@allparamPpr))){
+#     return(NULL)
+#   }
+#
+#   # construction my.envd1
+#   if(ExistdN){
+#
+#     #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 <-unique(yuimaPPr at data@original.data[,cond])[-1]
+#       assign(yuimaPPr at Ppr@counting.var[i], dummyData,envir=my.envd1)
+#     }
+#     # Names expression
+#     assign("NamesIntgra", NamesIntegrandExpr, envir=my.envd1)
+#     #dN
+#     namedX <-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@counting.var){
+#         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]))
+#         dummyData <- diff(as.numeric(yuimaPPr at data@original.data[,cond]))# We consider only Jump
+#         dummyJumpTime <- gridTime[-1][dummyData>0]
+#         dummyData2 <- diff(unique(cumsum(dummyData)))
+#         dummyData3 <- zoo(dummyData2,order.by = dummyJumpTime)
+#         assign(paste0("d",yuimaPPr at Kernel@variable.Integral at var.dx[i]), dummyData3 ,envir=my.envd1)
+#       }
+#     }
+#     assign("namedX",namedX, 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)
+#
+#     # Covariates
+#     if(length(yuimaPPr at Ppr@covariates)>1){
+#       # Covariates should be identified at jump time
+#       return(NULL)
+#     }
+#
+#   }
+#   # end coonstruction my.envd1
+#
+#   # construction my.envd2
+#   if(ExistdX){
+#     #Covariate
+#
+#     #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)
+#     }
+#
+#
+#   }else{
+#     assign("KerneldX",NULL,envir=my.envd2)
+#   }
+#
+#   # end construction my.envd2
+#
+#   # construction my.envd3
+#
+#   #Covariate
+#
+#   #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.envd3)
+#   }
+#   #time
+#   assign(yuimaPPr at model@time.variable, gridTime, my.envd3)
+#
+#   #Model
+#   assign("YUIMA.PPR",yuimaPPr,envir=my.envd3)
+#   assign("namesparam",namesparam,envir=my.envd3)
+#   assign("gfun",gfun,envir=my.envd3)
+#   assign("Integrand2",Integrand2,envir=my.envd3)
+#   assign("Integrand2expr",Integrand2expr,envir=my.envd3)
+#
+#   assign("gridTime",gridTime,envir=my.envd3)
+#   assign("Univariate",Univariate,envir=my.envd3)
+#   assign("ExistdN",ExistdN,envir=my.envd3)
+#   assign("ExistdX",ExistdX,envir=my.envd3)
+#
+#
+#   # end construction my.envd3
+#
+#
+#
+#
+#
+# ################################
+# # Start Intensity construction #
+# ################################
+#   #We define the parameters value for each environment
+#
+#   param<-unlist(param)
+#
+#   result<-InternalConstractionIntensity(param,my.envd1,
+#                                         my.envd2,my.envd3)
+#
+#   Int2<-zoo(as.matrix(result),order.by = gridTime)
+#   colnames(Int2)<-"lambda"
+#   res<-setData(Int2)
+#   return(res)
+#
+#
+# }

Modified: pkg/yuima/R/yuima.model.R
===================================================================
--- pkg/yuima/R/yuima.model.R	2017-01-23 08:01:57 UTC (rev 577)
+++ pkg/yuima/R/yuima.model.R	2017-01-23 09:40:08 UTC (rev 578)
@@ -166,6 +166,10 @@
 
       if(dim(jump.coeff)[2]!=1){
         intensity <- NULL
+        if(is.null(names(measure)) || names(measure)=="df"){
+          names(measure) <- "df"
+        }
+
         df <- as.list(measure[["df"]])
         if(any(measure.type=="CP")){
           intensity <- measure[["intensity"]]



More information about the Yuima-commits mailing list