[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