[Yuima-commits] r722 - pkg/yuima/R
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Thu Feb 20 20:38:03 CET 2020
Author: lorenzo
Date: 2020-02-20 20:38:02 +0100 (Thu, 20 Feb 2020)
New Revision: 722
Modified:
pkg/yuima/R/qmleLevy.R
Log:
updated qmleLevy
Modified: pkg/yuima/R/qmleLevy.R
===================================================================
--- pkg/yuima/R/qmleLevy.R 2020-02-19 19:09:03 UTC (rev 721)
+++ pkg/yuima/R/qmleLevy.R 2020-02-20 19:38:02 UTC (rev 722)
@@ -11,7 +11,7 @@
parameter<-yuima at model@parameter at all
orig.mylaw<-yuima at model@measure
mylaw<-yuima at model@measure$df
-
+ numbLev<-length(yuima at model@measure.type)
if(missing(yuima))
yuima.stop("yuima object is missing.")
@@ -301,37 +301,49 @@
cat("\nStarting Estimation of Levy Increments ... \n")
data <- get.zoo.data(yuima)
s.size<-yuima at sampling@n
- X<-as.numeric(data[[1]])
- pX<-X[1:(s.size-1)]
- inc<-double(s.size-1)
- inc<-X[2:(s.size)]-pX
+ if(length(data)==1){
+ X<-as.numeric(data[[1]])
+ pX<-X[1:(s.size-1)]
+ inc<-double(s.size-1)
+ inc<-X[2:(s.size)]-pX
+ }else{
+ pX<- simplify2array(lapply(X = data,
+ FUN = as.numeric))
+ pX<-pX[-nrow(pX),]
+ inc<- simplify2array(lapply(X = data,
+ FUN = function(X){diff(as.numeric(X))}))
+
+ }
+
modeltime<-yuima at model@time.variable
modelstate<-yuima at model@solve.variable
tmp.env<-new.env()
+ if(joint){
+ coeffic<- coef(res)
+ }else{
+ coeffic<- res[[1]]
+ if(length(res)>1){
+ for(j in c(2:length(res))){
+ coeffic<-c(coeffic,res[[j]])
+ }
+ }
+
+ }
+ mp<-match(names(coeffic),parameter)
+ esort <- coeffic[order(mp)]
+ for(i in 1:length(coeffic))
+ {
+ assign(parameter[i],esort[[i]],envir=tmp.env)
+ }
+
# DRIFT <- yuima at model@drift
# JUMP <- yuima at model@jump.coeff
if(length(yuima at model@solve.variable)==1){
#parameter<-yuima at model@parameter at all
- if(joint){
- coeffic<- coef(res)
- }else{
- coeffic<- res[[1]]
- if(length(res)>1){
- for(j in c(2:length(res))){
- coeffic<-c(coeffic,res[[j]])
- }
- }
-
- }
- mp<-match(names(coeffic),parameter)
- esort <- coeffic[order(mp)]
- for(i in 1:length(coeffic))
- {
- assign(parameter[i],esort[[i]],envir=tmp.env)
- }
+
resi<-double(s.size-1)
assign(modeltime,yuima at sampling@delta,envir=tmp.env)
h<-yuima at sampling@delta
@@ -359,8 +371,95 @@
res.incr<-resi
}
- }else{}
+ }else{
+ h<-yuima at sampling@delta
+
+ Tbig<-dim(inc)[1]
+ assign(modeltime,h,envir=tmp.env)
+ numbofvar<- length(modelstate)
+ for(j in c(1:numbofvar)){
+ assign(modelstate[j],pX[,j],envir=tmp.env)
+ }
+
+
+ drif.term<-array(0,c(Tbig,numbofvar))
+ for(i in c(1:numbofvar))
+ drif.term [,i]<- eval(DRIFT[i],envir=tmp.env)
+ # Check using variable in the drift
+
+ # jump.term<-sapply(1:numbofvar,function(i){
+ # sapply(1:numbLev, function(j){
+ # eval(JUMP[[i]][j],envir=tmp.env)
+ # },simplify = TRUE)
+ # },simplify = TRUE)
+
+ jump.term<-array(0,c(numbofvar,numbLev,Tbig))
+ for(i in c(1:numbofvar)){
+ for(j in c(1:numbLev))
+ jump.term[i,j, ] <- eval(JUMP[[i]][j],envir=tmp.env)
+ }
+
+
+ # if(dim(jump.term)[1]==numbofvar){
+ # if(dim(jump.term)[2]==numbofvar){
+ # if(det(jump.term)==0){
+ # Invjump.term<-solve(t(jump.term)%*%jump.term)%*%t(jump.term)
+ # }else{
+ # Invjump.term<-solve(jump.term)
+ # }
+ # }else{
+ # Invjump.term<-solve(t(jump.term)%*%jump.term)%*%t(jump.term)
+ # }
+ # Invjump.term <- Invjump.term%o%rep(1,Tbig)
+ # }else{
+ #
+ # }
+ #
+ DeltaInc<-(inc-drif.term*h)
+ if(dim(jump.term)[1]==numbofvar){
+ if(dim(jump.term)[2]==numbofvar){
+ resi<-t(sapply(i:Tbig,function(i){
+ if(det(jump.term[,,i])==0){
+ step1<-t(jump.term[,,i])%*%jump.term[,,i]
+ if(det(step1)==0){
+ Invjump.term<-diag(rep(1,dim(step1)[1]))
+ }else{
+ Invjump.term<-solve(step1)%*%t(jump.term[,,i])
+ }
+ }else{
+ Invjump.term<-solve(jump.term[,,i])
+ }
+ Invjump.term%*% DeltaInc[i,]
+ }
+ )
+ )
+ }else{
+ resi<-t(sapply(i:Tbig,function(i){
+ step1<-t(jump.term[,,i])%*%jump.term[,,i]
+ if(det(step1)==0){
+ Invjump.term<-diag(rep(1,dim(step1)[1]))
+ }else{
+ Invjump.term<-solve(step1)%*%t(jump.term[,,i])
+ }
+ Invjump.term%*% DeltaInc[i,]
+ }
+ )
+ )
+ }
+ }
+
+ if(aggregation){
+ Ter <- min(floor(yuima at sampling@Terminal))
+
+ res.incr<-t(sapply(1:Ter,function(i) colSums(resi[(floor((i-1)/h)):(floor(i/h)-1),]) ))
+
+ }else{
+ res.incr<-resi
+ }
+ }
+
+
if(Est.Incr == "Incr"){
return(list(res=res,Est.Incr=res.incr))
}
More information about the Yuima-commits
mailing list