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

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Wed May 6 22:41:08 CEST 2015


Author: lorenzo
Date: 2015-05-06 22:41:08 +0200 (Wed, 06 May 2015)
New Revision: 382

Modified:
   pkg/yuima/R/DiagnosticCogarch.R
   pkg/yuima/R/MM.COGARCH.R
   pkg/yuima/R/yuima.R
Log:
Modified MM.COGARCH

Modified: pkg/yuima/R/DiagnosticCogarch.R
===================================================================
--- pkg/yuima/R/DiagnosticCogarch.R	2015-04-26 16:18:40 UTC (rev 381)
+++ pkg/yuima/R/DiagnosticCogarch.R	2015-05-06 20:41:08 UTC (rev 382)
@@ -75,15 +75,22 @@
     lambda.eig<-diag(solve(matrixS)%*%Amatr%*%matrixS)
   }
   lambda1<- max(Re(lambda.eig)) # we find lambda1
-  ev.dum<-matrix(0,info at q,1)
-  ev.dum[info at q,1] <- 1
-  av.dum <-matrix(0,1,info at q)
-  av.dum[1,c(1:info at p)]<-acoeff 
+  ev.dum<-matrix(0,1,info at q)
+  ev.dum[1,info at q] <- 1
+  av.dum <-matrix(0,info at q,1)
+  av.dum[c(1:info at p),1]<-acoeff 
   if(display==TRUE){
     cat(paste0("\n COGARCH(",info at p,info at q,") model \n"))
   }
   matrforck<-solve(matrixS)%*%(av.dum%*%ev.dum)%*%matrixS
-  if(matrforck*mu < -lambda1){
+  if(is.complex(matrforck)){
+    A2Matrix<-Conj(t(matrforck))%*%matrforck
+    SpectNorm<-max(sqrt(as.numeric(abs(eigen(A2Matrix)$values))))
+  }else{
+    A2Matrix<-t(matrforck)%*%matrforck
+    SpectNorm<-max(sqrt(abs(eigen(A2Matrix)$values)))
+  }
+  if(SpectNorm*mu < -lambda1){
     if(display==TRUE){
       cat("\n The process is strictly stationary\n The unconditional first moment of the Variance process exists \n")
     }

Modified: pkg/yuima/R/MM.COGARCH.R
===================================================================
--- pkg/yuima/R/MM.COGARCH.R	2015-04-26 16:18:40 UTC (rev 381)
+++ pkg/yuima/R/MM.COGARCH.R	2015-05-06 20:41:08 UTC (rev 382)
@@ -190,8 +190,12 @@
   EL1.idx <- match("EL1",fullcoeff)  # We decide to pass EL1 as parameter !!!
 
   env <- new.env()
-  n <- length(observ)[1]
+#  n <- length(observ)[1]
+
+  #n <- attr(observ at original.data,"tsp")[2]
   
+  n <- length(index(observ at original.data))
+
   #Lag
   assign("lag", lag.max, envir=env)
   
@@ -344,16 +348,25 @@
                          r=env$r, h=seq(1, env$d, by = 1)*env$r, type=typeacf, 
                          m2=env$mu_G2, var=env$var_G2)
     if(objFun == "L2"){
-      min <- log(sum((score0$acfG2[CovQuad>0]-CovQuad[CovQuad>0])^2))
+    #  min <- log(sum((score0$acfG2[CovQuad>0]-CovQuad[CovQuad>0])^2))
+      
+      min <- log(sum((score0$acfG2-CovQuad)^2))
+      #min <- log(sum((score0$acfG2[CovQuad>0]-CovQuad[CovQuad>0])^2))
     }          
   idx.aaa<-match(loc.par,names_coef)           
-  gradVect <- gradVect0[names_coef[-idx.aaa],]
+  gradVect <- gradVect0[names_coef[-idx.aaa], ]
+  # gradVect <- gradVect0[names_coef[-idx.aaa],CovQuad>0]
   score <- c(score0$acfG2)%*%matrix(1,1,example$leng)
+  #score <- c(score0$acfG2[CovQuad>0])%*%matrix(1,1,example$leng)
+  
   #We need to write the matrix W for the matrix sandwhich
 #plot(as.numeric(example$dataused)[-1],type="h")
   #S_matrix
 
   EmpirScore <-score-example$elem[-1,]
+#   exampelem <-example$elem[-1,]
+#   EmpirScore <-score-exampelem[CovQuad>0,]
+  
   Omega_est<-tryCatch((1/example$leng*EmpirScore%*%t(EmpirScore)), 
                    error=function(theta){NULL})
   if(is.null(Omega_est)){
@@ -609,12 +622,20 @@
  }
 
  if(env$objFun=="L2"){
- #  res <- log(sum((TheoCovQuad[CovQuad>0]-CovQuad[CovQuad>0])^2))
+#  res <- log(sum((TheoCovQuad[CovQuad>0]-CovQuad[CovQuad>0])^2))
+
 #    emp <- log(CovQuad[CovQuad>0])
 #    theo <- log(TheoCovQuad[CovQuad>0])
-   res <- sum((log(abs(TheoCovQuad[CovQuad>0]))-log(abs(CovQuad[CovQuad>0])))^2)
-  # res <- sum((TheoCovQuad[CovQuad>0]-CovQuad[CovQuad>0])^2)
- # res <- sum((log(abs(TheoCovQuad))-log(abs(CovQuad)))^2)
+#   res <- log(sum((abs(TheoCovQuad)-abs(CovQuad))^2))
+   
+   
+ res <- sum((log(TheoCovQuad[CovQuad>0])-log(CovQuad[CovQuad>0]))^2)
+
+  #   res <- sum((TheoCovQuad[CovQuad>0]-CovQuad[CovQuad>0])^2)
+  # res <- sum((TheoCovQuad-CovQuad)^2)
+  
+#  res <- sum((log(abs(TheoCovQuad))-log(abs(CovQuad)))^2)
+  
   # res <- sum((log(TheoCovQuad[CovQuad>0]))-log(CovQuad[CovQuad>0]))^2)
   return(res)
  }
@@ -728,7 +749,7 @@
 
 
 MM_grad_Cogarch <- function(p, q, acoeff,cost, b,  r, h, type, m2, var){
-  eps<-10^(-4)
+  eps<-10^(-3)
   PartialP<-matrix(0,p,length(h))
   epsA<-eps*diag(p)
   for(i in c(1:p)){

Modified: pkg/yuima/R/yuima.R
===================================================================
--- pkg/yuima/R/yuima.R	2015-04-26 16:18:40 UTC (rev 381)
+++ pkg/yuima/R/yuima.R	2015-05-06 20:41:08 UTC (rev 382)
@@ -257,7 +257,7 @@
 #         data<-setData(zoo(x=matrix(as.numeric(data at original.data),length(data at original.data),
 #                                    (model at info@p+1)), order.by=time(data at zoo.data[[1]])))  
         dum.matr<-matrix(0,length(data at original.data),
-                         (model at info@p+2))
+                         (model at info@q+2))
         dum.matr[,1]<-as.numeric(data at original.data)
         data<-setData(zoo(x=dum.matr, order.by=time(data at zoo.data[[1]])))  
         



More information about the Yuima-commits mailing list