[Yuima-commits] r793 - in pkg/yuima: . R
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Tue Mar 22 09:58:54 CET 2022
Author: kyuta
Date: 2022-03-22 09:58:53 +0100 (Tue, 22 Mar 2022)
New Revision: 793
Modified:
pkg/yuima/DESCRIPTION
pkg/yuima/NEWS
pkg/yuima/R/IC.R
pkg/yuima/R/lambdaPPR.R
pkg/yuima/R/qmle.R
pkg/yuima/R/qmleLevy.R
pkg/yuima/R/toLatex.R
pkg/yuima/R/wllag.R
pkg/yuima/R/yuima.R
pkg/yuima/R/yuima.data.R
Log:
fixed if-class issues
Modified: pkg/yuima/DESCRIPTION
===================================================================
--- pkg/yuima/DESCRIPTION 2022-03-03 14:01:02 UTC (rev 792)
+++ pkg/yuima/DESCRIPTION 2022-03-22 08:58:53 UTC (rev 793)
@@ -1,7 +1,7 @@
Package: yuima
Type: Package
Title: The YUIMA Project Package for SDEs
-Version: 1.15.5
+Version: 1.15.6
Depends: R(>= 2.10.0), methods, zoo, stats4, utils, expm, cubature,
mvtnorm
Imports: Rcpp (>= 0.12.1), boot (>= 1.3-2), glassoFast,
Modified: pkg/yuima/NEWS
===================================================================
--- pkg/yuima/NEWS 2022-03-03 14:01:02 UTC (rev 792)
+++ pkg/yuima/NEWS 2022-03-22 08:58:53 UTC (rev 793)
@@ -96,4 +96,5 @@
updated DESCRIPTION to add package calculus in Imports
2022/01/25: fixed a protection issue in euler.c
2022/01/28: modified wllag.R and unimported the wavethresh package
-2022/03/03: fixed a bug in euler.c
\ No newline at end of file
+2022/03/03: fixed a bug in euler.c
+2022/03/22: fixed if-class issues
\ No newline at end of file
Modified: pkg/yuima/R/IC.R
===================================================================
--- pkg/yuima/R/IC.R 2022-03-03 14:01:02 UTC (rev 792)
+++ pkg/yuima/R/IC.R 2022-03-22 08:58:53 UTC (rev 793)
@@ -315,7 +315,8 @@
Diff.esti.bic.sub <- gsub(swbeta[[BIC.opt1]][(j+1)], Esti1.chr.bic[(j+1)], Diff.esti.bic.sub)
}
}
- if(class(Diff.esti.bic) == "character"){
+ #if(class(Diff.esti.bic) == "character"){
+ if(inherits(Diff.esti.bic, "character")){ # YK, Mar. 22, 2022
Diff.esti.bic <- Diff.esti.bic.sub
}else{
Diff.esti.bic[i,] <- Diff.esti.bic.sub
@@ -335,7 +336,8 @@
Diff.esti.qbic.sub <- gsub(swbeta[[QBIC.opt1]][(j+1)], Esti1.chr.qbic[(j+1)], Diff.esti.qbic.sub)
}
}
- if(class(Diff.esti.qbic) == "character"){
+ #if(class(Diff.esti.qbic) == "character"){
+ if(inherits(Diff.esti.qbic, "character")){ # YK, Mar. 22, 2022
Diff.esti.qbic <- Diff.esti.qbic.sub
}else{
Diff.esti.qbic[i,] <- Diff.esti.qbic.sub
@@ -439,7 +441,8 @@
Diff.esti.sub <- gsub(swbeta[[i]][(k+1)], Esti1.chr[(k+1)], Diff.esti.sub)
}
}
- if(class(Diff.esti) == "character"){
+ #if(class(Diff.esti) == "character"){
+ if(inherits(Diff.esti, "character")){ # YK, Mar. 22, 2022
Diff.esti <- Diff.esti.sub
}else{
Diff.esti[j,] <- Diff.esti.sub
Modified: pkg/yuima/R/lambdaPPR.R
===================================================================
--- pkg/yuima/R/lambdaPPR.R 2022-03-03 14:01:02 UTC (rev 792)
+++ pkg/yuima/R/lambdaPPR.R 2022-03-22 08:58:53 UTC (rev 793)
@@ -1,930 +1,931 @@
-# auxiliar function for the evaluation of g(t,X_t,N_t, theta)
-internalGfunFromPPRModel <- function(gfun,my.envd3, univariate=TRUE){
- if(univariate){
- res<-as.numeric(eval(gfun, envir=my.envd3))
- }else{res<-NULL}
- return(res)
-}
-
-# auxiliar function for the evaluation of Kernel
-InternalKernelFromPPRModel<-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
-
- IntegralKernelDum<- sum(eval(Integrand2expr[cond], envir=my.envd1))
- IntegralKernel<-IntegralKernel+IntegralKernelDum
- # cat("\n", IntegralKernel)
- }
- }
-
- }else{
- return(NULL)
- }
-
- return(IntegralKernel)
-}
-
-# auxiliar function for the evaluation of Intensity
-InternalConstractionIntensity<-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=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
-
-}
-
-InternalConstractionIntensityFeedBackIntegrand<-function(param,my.envd1,
- my.envd2,my.envd3){
- 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
-
- allVarsInG<- all.vars(gfun)
- CondIntFeedBacksToG <- my.envd3$YUIMA.PPR at PPR@additional.info %in% allVarsInG
-
- 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)
- }
-
-
- # 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])
- # }
-
- if(Univariate){
- NameCol <- colnames(Integrand2)
-
- # Kernel <- sapply(X=gridTime,FUN = InternalKernelFromPPRModel3,
- # Integrand2=Integrand2, Integrand2expr = Integrand2expr,my.envd1=my.envd1,my.envd2=my.envd2,
- # my.envd3=my.envd3,
- # Univariate=Univariate, ExistdN =ExistdN, ExistdX=ExistdX,
- # dimCol=dim(Integrand2)[2], NameCol = NameCol,
- # JumpTimeName =paste0("JumpTime.",NameCol))
- # Kernel <- evalKernelCpp2(Integrand2,
- # Integrand2expr,
- # my.envd1, my.envd2, my.envd3$YUIMA.PPR at PPR@IntensWithCount,
- # my.envd3$YUIMA.PPR at PPR@counting.var,
- # my.envd3$YUIMA.PPR at PPR@covariates,
- # ExistdN, ExistdX,
- # gridTime, dimCol = dim(Integrand2)[2], NameCol = NameCol,
- # JumpTimeName =paste0("JumpTime.",NameCol))
- # Evalgfun <- internalGfunFromPPRModel(gfun[i],my.envd3, univariate=TRUE)
- # result<-Kernel+Evalgfun
- kernel <- numeric(length = length(gridTime))
- Intensity <- numeric(length = length(gridTime))
- JumpTimeName <- paste0("JumpTime.", NameCol)
- dimCol <- dim(Integrand2)[2]
- IntensityatJumpTime<-as.list(numeric(length=length(gridTime)))
- differentialCounting <- paste0("d",
- c(my.envd3$YUIMA.PPR at PPR@counting.var,
- my.envd3$YUIMA.PPR at PPR@additional.info))
- if(!CondIntFeedBacksToG){
- EvalGFUN <- eval(gfun,envir=my.envd3)
- Intensity[1]<-EvalGFUN[1]
- }
- aaaa<- length(gridTime)
- CondallJump <- rep(FALSE,aaaa+1)
-
- for(t in c(2:aaaa)){
- assign(my.envd1$t.time,gridTime[[t]][1],envir=my.envd1)
- for(j in c(1:dimCol)){
- if(NameCol[j] %in% differentialCounting){
- # Intensity at Jump Time
- assign(my.envd3$YUIMA.PPR at PPR@additional.info,
- IntensityatJumpTime[[t-1]],
- envir=my.envd1)
- # Counting Var at Jump Time
- assign(my.envd3$YUIMA.PPR at PPR@counting.var,
- my.envd1[[my.envd1$PosListCountingVariable]][[t]],
- envir=my.envd1)
- # Jump time <= t
- assign(my.envd1$var.time,my.envd1[[JumpTimeName[j]]][[t]],envir=my.envd1)
- KerneldN <- sum(eval(Integrand2expr,envir=my.envd1)*my.envd1[[my.envd1$namedX[j]]][[t]])
- kernel[t-1] <- KerneldN
- }
-
- }
- # Evaluation gFun
- if(!CondIntFeedBacksToG){
- #EvalGFUN <- eval(gfun,envir=my.envd3)
- if(t<=aaaa){
- Intensity[t]<- EvalGFUN[t-1]+kernel[t-1]
- }
- }else{
- # Here we evaluate gFun time by time
-
- }
-
- for(j in c(1:dimCol)){
- if(t+1<=aaaa){
- if(NameCol[j] %in% differentialCounting){
- #
- CondallJump[t] <-my.envd3$JumpTimeLogical[t]
- IntensityatJumpTime[[t]]<- Intensity[CondallJump[-1]]
-
- }
- }
- }
- if(t==77){
- ff<-2
- }
- }
-
- }else{
- n.row <- length(my.envd3$YUIMA.PPR at PPR@counting.var)
- n.col <- length(gridTime)
- result <- matrix(NA,n.row, n.col)
- #Kernel<- numeric(length=n.col-1)
-
- dimCol<- dim(Integrand2)[2]
- NameCol<-colnames(Integrand2)
- JumpTimeName <- paste0("JumpTime.",NameCol)
-
- for(i in c(1:n.row)){
-
- # Kernel <- sapply(X=gridTime,FUN = InternalKernelFromPPRModel2,
- # Integrand2=t(Integrand2[i,]), Integrand2expr = Integrand2expr[[i]],my.envd1=my.envd1,my.envd2=my.envd2,
- # Univariate=TRUE, ExistdN =ExistdN, ExistdX=ExistdX, dimCol=dimCol, NameCol = NameCol,
- # JumpTimeName =JumpTimeName)
- # Kernel <- evalKernelCpp2(t(Integrand2[i,]), Integrand2expr[[i]],
- # my.envd1, my.envd2, my.envd3$YUIMA.PPR at PPR@IntensWithCount,
- # my.envd3$YUIMA.PPR at PPR@counting.var,
- # my.envd3$YUIMA.PPR at PPR@covariates,
- # ExistdN, ExistdX,
- # gridTime, dimCol = dim(Integrand2)[2], NameCol = NameCol,
- # JumpTimeName =paste0("JumpTime.",NameCol))
-
- # Evalgfun <- internalGfunFromPPRModel(gfun[i],my.envd3, univariate=TRUE)
- # result[i,]<-Kernel+Evalgfun
- }
- }
- return(Intensity)
-}
-
-InternalKernelFromPPRModel2<-function(Integrand2,Integrand2expr,my.envd1=NULL,my.envd2=NULL,
- Univariate=TRUE, ExistdN, ExistdX, gridTime, dimCol, NameCol,
- JumpTimeName){
-
- if(Univariate){
- # JumpTimeName <- paste0("JumpTime.",NameCol[i])
- # dimCol<- dim(Integrand2)[2]
- # NameCol<-colnames(Integrand2)
- 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
- if(ExistdN){
- # cond <- paste0("JumpTime.",NameCol[i]) %in% my.envd1$namedJumpTimeX
- # cond <- my.envd1$namedJumpTimeX %in% paste0("JumpTime.",NameCol[i])
- cond <- my.envd1$namedJumpTimeX %in% JumpTimeName[i]
-
- if(any(cond)){
- assign(my.envd1$var.time,my.envd1[[my.envd1$namedJumpTimeX[cond]]],envir=my.envd1)
- # condpos <- NameCol %in% my.envd1$namedX
- condpos <- my.envd1$namedX %in% NameCol[i]
- 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
- # cond <- my.envd2$namedJumpTimeX %in% paste0("JumpTime.",NameCol[i])
- cond <- my.envd2$namedJumpTimeX %in% JumpTimeName[i]
- if(any(cond)){
- assign(my.envd2$var.time,my.envd2[[my.envd2$namedJumpTimeX[cond]]],envir=my.envd2)
- # condpos <- NameCol %in% my.envd2$namedX
- condpos <- my.envd2$namedX %in% NameCol[i]
- if(any(condpos)){
- IntegralKernelDum<- sum(eval(Integrand2expr[condpos], envir=my.envd2))
- IntegralKernel<-IntegralKernel+IntegralKernelDum
- }
- }
- }
-
-
- }
-
- }else{
- return(NULL)
- }
-
- return(IntegralKernel)
-}
-
-InternalKernelFromPPRModel3<-function(Integrand2,Integrand2expr,my.envd1=NULL,my.envd2=NULL,my.envd3=NULL,
- Univariate=TRUE, ExistdN, ExistdX, gridTime, dimCol, NameCol,
- JumpTimeName){
-
- if(Univariate){
- # JumpTimeName <- paste0("JumpTime.",NameCol[i])
- # dimCol<- dim(Integrand2)[2]
- # NameCol<-colnames(Integrand2)
- if(ExistdN){
- #assign(my.envd1$t.time,gridTime[1], envir=my.envd1)
- my.envd1[[my.envd1$t.time]]<-gridTime[1]
- }
- if(ExistdX){
- assign(my.envd2$t.time,gridTime[1], envir=my.envd2)
- }
- if(my.envd3$YUIMA.PPR at PPR@IntensWithCount){
- for(i in c(1:length(my.envd3$YUIMA.PPR at PPR@counting.var))){
- # assign(my.envd3$YUIMA.PPR at PPR@counting.var[i],
- # my.envd1[[my.envd1$PosListCountingVariable[i]]][[gridTime[2]]]
- # ,envir = my.envd1)
- my.envd1[[my.envd3$YUIMA.PPR at PPR@counting.var[i]]]<-my.envd1[[my.envd1$PosListCountingVariable[i]]][[gridTime[2]]]
- }
- if(length(my.envd3$YUIMA.PPR at PPR@covariates)>0){
- for(i in c(1:length(my.envd3$YUIMA.PPR at PPR@covariates))){
- # assign(my.envd3$YUIMA.PPR at PPR@covariates[i],
- # my.envd1[[my.envd1$PosListCovariates[i]]][[gridTime[2]]]
- # ,envir = my.envd1)
- my.envd1[[my.envd3$YUIMA.PPR at PPR@covariates[i]]]<-my.envd1[[my.envd1$PosListCovariates[i]]][[gridTime[2]]]
- }
- }
- }
- 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
- if(ExistdN){
- # cond <- paste0("JumpTime.",NameCol[i]) %in% my.envd1$namedJumpTimeX
- # cond <- my.envd1$namedJumpTimeX %in% paste0("JumpTime.",NameCol[i])
- cond <- my.envd1$namedJumpTimeX %in% JumpTimeName[i]
-
- if(any(cond)){
- assign(my.envd1$var.time,my.envd1[[my.envd1$namedJumpTimeX[cond]]][[gridTime[2]]],envir=my.envd1)
- # condpos <- NameCol %in% my.envd1$namedX
- #condpos <- my.envd1$namedX %in% NameCol[i]
- condpos <- NameCol %in% NameCol[i]
- if(any(condpos)){
- InterDum <- eval(Integrand2expr[condpos], envir=my.envd1)*my.envd1[[NameCol[i]]][[gridTime[2]]]
- IntegralKernelDum<- sum(InterDum,na.rm=TRUE)
- IntegralKernel<-IntegralKernel+IntegralKernelDum
- }
- }
- }
-
- if(ExistdX){
- # cond <- paste0("JumpTime.",NameCol[i]) %in% my.envd2$namedJumpTimeX
- # cond <- my.envd2$namedJumpTimeX %in% paste0("JumpTime.",NameCol[i])
- cond <- my.envd2$namedJumpTimeX %in% JumpTimeName[i]
- if(any(cond)){
- #assign(my.envd2$var.time,my.envd2[[my.envd2$namedJumpTimeX[cond]]],envir=my.envd2)
- assign(my.envd2$var.time,my.envd2[[my.envd2$namedJumpTimeX[cond]]][1:gridTime[2]],envir=my.envd2)
- # condpos <- my.envd2$namedX %in% NameCol
- condpos <- NameCol %in% NameCol[i]
- if(any(condpos)){
- IntegralKernelDum<- sum(eval(Integrand2expr[condpos], envir=my.envd2)*my.envd2[[NameCol[i]]][1:gridTime[2]] , na.rm=TRUE)
- IntegralKernel<-IntegralKernel+IntegralKernelDum
- }
- }
- }
-
-
- }
-
- }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)
- }
-
-
- # 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])
- # }
-
- if(Univariate){
- # Kernel<- numeric(length=length(gridTime))
- NameCol <- colnames(Integrand2)
- # Kernel <- sapply(X=gridTime,FUN = InternalKernelFromPPRModel2,
- # Integrand2=Integrand2, Integrand2expr = Integrand2expr,my.envd1=my.envd1,my.envd2=my.envd2,
- # Univariate=Univariate, ExistdN =ExistdN, ExistdX=ExistdX,
- # dimCol=dim(Integrand2)[2], NameCol = NameCol,
- # JumpTimeName =paste0("JumpTime.",NameCol))
-
- # NameCol <- colnames(Integrand2)
- # Kernel <- evalKernelCpp(Integrand2, Integrand2expr,my.envd1, my.envd2,
- # ExistdN, ExistdX, gridTime, dim(Integrand2)[2], NameCol,
- # paste0("JumpTime.",NameCol))
-
- # Kernel <- sapply(X=gridTime,FUN = InternalKernelFromPPRModel3,
- # Integrand2=Integrand2, Integrand2expr = Integrand2expr,my.envd1=my.envd1,my.envd2=my.envd2,
- # my.envd3=my.envd3,
- # Univariate=Univariate, ExistdN =ExistdN, ExistdX=ExistdX,
- # dimCol=dim(Integrand2)[2], NameCol = NameCol,
- # JumpTimeName =paste0("JumpTime.",NameCol))
- Kernel <- evalKernelCpp2(Integrand2,
- Integrand2expr,
- my.envd1, my.envd2, my.envd3$YUIMA.PPR at PPR@IntensWithCount,
- my.envd3$YUIMA.PPR at PPR@counting.var,
- my.envd3$YUIMA.PPR at PPR@covariates,
- ExistdN, ExistdX,
- gridTime, dimCol = dim(Integrand2)[2], NameCol = NameCol,
- JumpTimeName =paste0("JumpTime.",NameCol))
- #KerneldCov<- numeric(length=length(gridTime))
- Evalgfun <- internalGfunFromPPRModel(gfun,my.envd3, univariate=Univariate)
- result<-Kernel+Evalgfun
- }else{
- n.row <- length(my.envd3$YUIMA.PPR at PPR@counting.var)
- n.col <- length(gridTime)
- result <- matrix(NA,n.row, n.col)
- #Kernel<- numeric(length=n.col-1)
-
- dimCol<- dim(Integrand2)[2]
- NameCol<-colnames(Integrand2)
- JumpTimeName <- paste0("JumpTime.",NameCol)
-
- for(i in c(1:n.row)){
- # Kernel <- pvec(v=gridTime,FUN = InternalKernelFromPPRModel2,
- # Integrand2=t(Integrand2[i,]), Integrand2expr = Integrand2expr[[i]],my.envd1=my.envd1,my.envd2=my.envd2,
- # Univariate=TRUE, ExistdN =ExistdN, ExistdX=ExistdX, dimCol=dimCol, NameCol = NameCol,
- # JumpTimeName =JumpTimeName)
- # Kernel <- sapply(X=gridTime,FUN = InternalKernelFromPPRModel2,
- # Integrand2=t(Integrand2[i,]), Integrand2expr = Integrand2expr[[i]],my.envd1=my.envd1,my.envd2=my.envd2,
- # Univariate=TRUE, ExistdN =ExistdN, ExistdX=ExistdX, dimCol=dimCol, NameCol = NameCol,
- # JumpTimeName =JumpTimeName)
- # Kernel <- sapply(X=gridTime,FUN = evalKernelCppPvec,
- # Integrand2=t(Integrand2[i,]), Integrand2expr = Integrand2expr[[i]],
- # myenvd1=my.envd1,myenvd2=my.envd2,
- # ExistdN =ExistdN, ExistdX=ExistdX,
- # dimCol=dimCol, NameCol = NameCol,
- # JumpTimeName =JumpTimeName)
- # Kernel <- evalKernelCpp(t(Integrand2[i,]), Integrand2expr[[i]],my.envd1, my.envd2,
- # ExistdN, ExistdX, gridTime, dimCol, NameCol,
- # JumpTimeName)
- Kernel <- evalKernelCpp2(t(Integrand2[i,]), Integrand2expr[[i]],
- my.envd1, my.envd2, my.envd3$YUIMA.PPR at PPR@IntensWithCount,
- my.envd3$YUIMA.PPR at PPR@counting.var,
- my.envd3$YUIMA.PPR at PPR@covariates,
- ExistdN, ExistdX,
- gridTime, dimCol = dim(Integrand2)[2], NameCol = NameCol,
- JumpTimeName =paste0("JumpTime.",NameCol))
- Evalgfun <- internalGfunFromPPRModel(gfun[i],my.envd3, univariate=TRUE)
- result[i,]<-Kernel+Evalgfun
- }
- }
- return(result)
-}
-
-
-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[i] <- as.character(yuimaPPR at Kernel@Integrand at IntegrandList[[i]])
- }
-
- 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))
- # 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)
- # }
- if(yuimaPPR at Kernel@Integrand at dimIntegrand[1]==1){
- Integrand2expr <- parse(text=Integrand2)
- }else{
- Integrand2expr <- list()
- for(hh in c(1:yuimaPPR at Kernel@Integrand at dimIntegrand[1])){
- Integrand2expr[[hh]] <- parse(text=Integrand2[hh,])
- }
- }
-
- 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 PPR@counting.var)){
- 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 PPR@covariates)){
- 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 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
- 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]
- dummyJumpTime <- gridTime[-1][dummyData!=0]
- dummyData2 <- diff(unique(cumsum(dummyData)))
- #dummyData3 <- zoo(dummyData2,order.by = dummyJumpTime)
- dummyData3 <- dummyData2
- JumpTime <- dummyJumpTime
- Jump <- lapply(X=as.numeric(gridTime), FUN = function(X,JumpT,Jump){Jump[JumpT<X]},
- JumpT = dummyJumpTime, Jump = as.numeric(dummyData3!=0))
- assign(paste0("d",yuimaPPR at Kernel@variable.Integral at var.dx[i]),
- Jump ,
- envir=my.envd1)
- dummyJumpTimeNew <- lapply(X=as.numeric(gridTime), FUN = function(X,JumpT){JumpT[JumpT<X]},
- JumpT = dummyJumpTime)
- assign(paste0("JumpTime.d",yuimaPPR at Kernel@variable.Integral at var.dx[i]), dummyJumpTimeNew ,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)
-
- #CountingVariable
- PosListCountingVariable <- NULL
- for(i in c(1:length(yuimaPPR at PPR@counting.var))){
- cond <- yuimaPPR at model@solve.variable %in% yuimaPPR at PPR@counting.var[i]
- JUMPTIME <- tail(my.envd1[[paste0("JumpTime.d",yuimaPPR at Kernel@variable.Integral at var.dx[i])]],1L)[[1]]
- condTime <- gridTime %in% JUMPTIME
-
- dummyData <- yuimaPPR at data@original.data[condTime,cond]
- dummyDataA <- lapply(X=as.numeric(gridTime), FUN = function(X,JumpT,Jump){Jump[JumpT<X]},
- JumpT = JUMPTIME, Jump = dummyData)
- dummyList <- paste0("List_",yuimaPPR at PPR@counting.var[i])
- PosListCountingVariable <- c(PosListCountingVariable,dummyList)
- assign(dummyList, dummyDataA, envir=my.envd1)
- assign(yuimaPPR at PPR@counting.var[i], numeric(length=0L), envir=my.envd1)
- }
- assign("PosListCountingVariable", PosListCountingVariable, envir=my.envd1)
- # Covariates
- if(length(yuimaPPR at PPR@covariates)>0){
- # Covariates should be identified at jump time
- # return(NULL)
- PosListCovariates <- 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[condTime, cond]
- dummyDataB <- lapply(X=as.numeric(gridTime), FUN = function(X,JumpT,Jump){Jump[JumpT<X]},
- JumpT = JUMPTIME, Jump = dummyData)
- dummyListCov <- paste0("List_",yuimaPPR at PPR@covariates[i])
- PosListCovariates <- c(PosListCovariates,dummyListCov)
- assign(dummyListCov, dummyDataB,envir=my.envd1)
- assign(yuimaPPR at PPR@covariates[i], numeric(length=0L),envir=my.envd1)
- }
- assign("PosListCovariates", PosListCovariates,envir=my.envd1)
- }
-
- }
- # end coonstruction my.envd1
-
- # construction my.envd2
- if(ExistdX){
- #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 <-as.numeric(yuimaPPR at data@original.data[,cond])
- # assign(yuimaPPR at PPR@counting.var[i], dummyData[-length(dummyData)],envir=my.envd2)
- assign(yuimaPPR at PPR@counting.var[i], 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("d",yuimaPPR at Kernel@variable.Integral at var.dx[i]), c(0,dummyData) ,envir=my.envd2)
- #assign(paste0("JumpTime.d",yuimaPPR at Kernel@variable.Integral at var.dx[i]), gridTime[-1] ,envir=my.envd2)
- assign(paste0("JumpTime.d",yuimaPPR at Kernel@variable.Integral at var.dx[i]), as.numeric(gridTime) ,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)
- assign(yuimaPPR at PPR@covariates[i], dummyData,envir=my.envd2)
- }
-
- }else{
- assign("KerneldX",NULL,envir=my.envd2)
- }
-
- # end construction my.envd2
-
- # construction my.envd3
-
- #Covariate
- dimCov <- length(yuimaPPR at PPR@covariates)
- if(dimCov>0){
- for(j in c(1:dimCov)){
- cond <- yuimaPPR at model@solve.variable %in% yuimaPPR at PPR@covariates[j]
- dummyData <-yuimaPPR at data@original.data[,cond]
- assign(yuimaPPR at PPR@covariates[j], dummyData,envir=my.envd3)
- }
- }
-
- #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.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)
-
- l1 =as.list(as.numeric(gridTime))
- l2 = as.list(c(1:(length(l1))))
- l3 = mapply(c, l1, l2, SIMPLIFY=FALSE)
-
- assign("gridTime",l3,envir=my.envd3)
- assign("Univariate",Univariate,envir=my.envd3)
- assign("ExistdN",ExistdN,envir=my.envd3)
- assign("ExistdX",ExistdX,envir=my.envd3)
-
- assign("JumpTimeLogical",c(FALSE,as.integer(diff(my.envd3$N))!=0),envir=my.envd3)
-
- # end construction my.envd3
-
-
-
-
-
- ################################
- # Start Intensity construction #
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/yuima -r 793
More information about the Yuima-commits
mailing list