[Yuima-commits] r723 - in pkg/yuima: R man

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Wed Feb 26 22:53:04 CET 2020


Author: lorenzo
Date: 2020-02-26 22:53:03 +0100 (Wed, 26 Feb 2020)
New Revision: 723

Added:
   pkg/yuima/man/yuima.qmleLevy.incr-class.Rd
Modified:
   pkg/yuima/R/NewClasses.R
   pkg/yuima/R/qmleLevy.R
Log:
Updated qmleLevy, Uploaded new class for a Levy SDE model

Modified: pkg/yuima/R/NewClasses.R
===================================================================
--- pkg/yuima/R/NewClasses.R	2020-02-20 19:38:02 UTC (rev 722)
+++ pkg/yuima/R/NewClasses.R	2020-02-26 21:53:03 UTC (rev 723)
@@ -1,194 +1,233 @@
-# Here we insert new classes for extending the object of classes yuima
-setClass("param.Map",
-         representation(out.var = "character",
-                        allparam = "character",
-                        allparamMap = "character",
-                        common = "character",
-                        Input.var = "character",
-                        time.var = "character"))
-
-setClass("info.Map",
-         representation(formula="vector",
-                        dimension="numeric",
-                        type="character",
-                        param = "param.Map"))
-
-
-setClass("yuima.Map",
-         representation(Output = "info.Map"),
-         contains="yuima"
-           )
-
-# Initialization
-
-setMethod("initialize",
-           "param.Map",
-           function(.Object, out.var = character(),
-                    allparam = character(),
-                    allparamMap = character(),
-                    common = character(),
-                    Input.var = character(),
-                    time.var = character()){
-             .Object at out.var <- out.var
-             .Object at allparam <- allparam
-             .Object at allparamMap <- allparamMap
-             .Object at common <- common
-             .Object at Input.var <-Input.var
-             .Object at time.var <- time.var
-             return(.Object)
-           }
-)
-#
-setMethod("initialize",
-          "info.Map", function(.Object,
-                                  formula = vector(mode = expression),
-                                  dimension = numeric(),
-                                  type = character(),
-                                  param = new("param.Map")){
-                            .Object at formula <- formula
-                            .Object at dimension <- dimension
-                            .Object at type <- type
-                            .Object at param <- param
-                            return(.Object)
-                          }
-          )
-
-setMethod("initialize",
-          "yuima.Map",
-          function(.Object,
-                   #param = new("param.Map"),
-                   Output = new("info.Map"),
-                   yuima = new("yuima")){
-            #.Object at param <- param
-            .Object at Output <- Output
-            .Object at data <- yuima at data
-            .Object at model <- yuima at model
-            .Object at sampling <- yuima at sampling
-            .Object at characteristic <- yuima at characteristic
-            .Object at functional <- yuima at functional
-            return(.Object)
-
-          }
-)
-#
-# Class for yuima.integral  is structured as follows:
-
-#   param.Integral
-#     Integral$param$allparam
-#     Integral$param$common
-#     Integral$param$IntegrandParam
-
-setClass("param.Integral",representation(allparam = "character",
-  common = "character", Integrandparam = "character")
-)
-#
-setMethod("initialize","param.Integral",
-          function(.Object, allparam = character(),
-                   common = character(),
-                   Integrandparam = character()){
-            .Object at allparam <- allparam
-            .Object at common <- common
-            .Object at Integrandparam <- Integrandparam
-            return(.Object)
-          }
-)
-#
-# #   variable.Integral
-# #     Integral$var.dx
-# #     Integral$lower.var
-# #     Integral$upper.var
-# #     Integral$out.var
-# #     Integral$var.time <-"s"
-#
-setClass("variable.Integral",
-         representation(var.dx = "character",
-                        lower.var = "character",
-                        upper.var = "character",
-                        out.var = "character",
-                        var.time = "character")
-)
-#
-setMethod("initialize","variable.Integral",
-          function(.Object,
-                   var.dx = character(),
-                   lower.var = character(),
-                   upper.var = character(),
-                   out.var = character(),
-                   var.time = character()){
-            .Object at var.dx <- var.dx
-            .Object at lower.var <- lower.var
-            .Object at upper.var <- upper.var
-            .Object at out.var <- out.var
-            .Object at var.time <- var.time
-            return(.Object)
-          }
-          )
-
-#   Integrand
-#     Integral$IntegrandList
-#     Integral$dimIntegrand
-
-setClass("Integrand",
-         representation(IntegrandList = "list",
-                        dimIntegrand = "numeric")
-         )
-setMethod("initialize","Integrand",
-          function(.Object,
-                   IntegrandList = list(),
-                   dimIntegrand = numeric()){
-            .Object at IntegrandList <- IntegrandList
-            .Object at dimIntegrand <- dimIntegrand
-            return(.Object)
-          }
-          )
-#
-# #   Integral.sde
-#
-setClass("Integral.sde", representation(param.Integral = "param.Integral",
-                                        variable.Integral = "variable.Integral", Integrand = "Integrand")
-)
-#
-setMethod("initialize", "Integral.sde",
-          function(.Object,
-                   param.Integral = new("param.Integral"),
-                   variable.Integral = new("variable.Integral"),
-                   Integrand = new("Integrand")){
-            .Object at param.Integral <- param.Integral
-            .Object at variable.Integral <- variable.Integral
-            .Object at Integrand <- Integrand
-            return(.Object)
-          }
-)
-#
-# # yuima.Integral
-#
-setClass("yuima.Integral", representation(
-  Integral = "Integral.sde"),
-  contains = "yuima"
-)
-#
-setMethod("initialize", "yuima.Integral",
-          function(.Object,
-                   Integral = new("Integral.sde"),
-                   yuima = new("yuima")){
-            .Object at Integral <- Integral
-            #.Object at param <- param
-            #.Object at Output <- Output
-            .Object at data <- yuima at data
-            .Object at model <- yuima at model
-            .Object at sampling <- yuima at sampling
-            .Object at characteristic <- yuima at characteristic
-            .Object at functional <- yuima at functional
-            return(.Object)
-          }
-)
-#
-
-
-# yuima.multimodel. We replacate the yuima.model class in order to
-# describe from mathematical point of view the multi dimensional jump
-# diffusion model
-setClass("yuima.multimodel",
-         contains="yuima.model")
-
-setClass("yuima.snr", representation(call = "call", coef = "numeric", snr = "numeric", model = "yuima.model"), prototype = list(call = NULL, coef = NULL, snr = NULL, model = NULL))
+# Here we insert new classes for extending the object of classes yuima
+setClass("param.Map",
+         representation(out.var = "character",
+                        allparam = "character",
+                        allparamMap = "character",
+                        common = "character",
+                        Input.var = "character",
+                        time.var = "character"))
+
+setClass("info.Map",
+         representation(formula="vector",
+                        dimension="numeric",
+                        type="character",
+                        param = "param.Map"))
+
+
+setClass("yuima.Map",
+         representation(Output = "info.Map"),
+         contains="yuima"
+           )
+
+# Initialization
+
+setMethod("initialize",
+           "param.Map",
+           function(.Object, out.var = character(),
+                    allparam = character(),
+                    allparamMap = character(),
+                    common = character(),
+                    Input.var = character(),
+                    time.var = character()){
+             .Object at out.var <- out.var
+             .Object at allparam <- allparam
+             .Object at allparamMap <- allparamMap
+             .Object at common <- common
+             .Object at Input.var <-Input.var
+             .Object at time.var <- time.var
+             return(.Object)
+           }
+)
+#
+setMethod("initialize",
+          "info.Map", function(.Object,
+                                  formula = vector(mode = expression),
+                                  dimension = numeric(),
+                                  type = character(),
+                                  param = new("param.Map")){
+                            .Object at formula <- formula
+                            .Object at dimension <- dimension
+                            .Object at type <- type
+                            .Object at param <- param
+                            return(.Object)
+                          }
+          )
+
+setMethod("initialize",
+          "yuima.Map",
+          function(.Object,
+                   #param = new("param.Map"),
+                   Output = new("info.Map"),
+                   yuima = new("yuima")){
+            #.Object at param <- param
+            .Object at Output <- Output
+            .Object at data <- yuima at data
+            .Object at model <- yuima at model
+            .Object at sampling <- yuima at sampling
+            .Object at characteristic <- yuima at characteristic
+            .Object at functional <- yuima at functional
+            return(.Object)
+
+          }
+)
+#
+# Class for yuima.integral  is structured as follows:
+
+#   param.Integral
+#     Integral$param$allparam
+#     Integral$param$common
+#     Integral$param$IntegrandParam
+
+setClass("param.Integral",representation(allparam = "character",
+  common = "character", Integrandparam = "character")
+)
+#
+setMethod("initialize","param.Integral",
+          function(.Object, allparam = character(),
+                   common = character(),
+                   Integrandparam = character()){
+            .Object at allparam <- allparam
+            .Object at common <- common
+            .Object at Integrandparam <- Integrandparam
+            return(.Object)
+          }
+)
+#
+# #   variable.Integral
+# #     Integral$var.dx
+# #     Integral$lower.var
+# #     Integral$upper.var
+# #     Integral$out.var
+# #     Integral$var.time <-"s"
+#
+setClass("variable.Integral",
+         representation(var.dx = "character",
+                        lower.var = "character",
+                        upper.var = "character",
+                        out.var = "character",
+                        var.time = "character")
+)
+#
+setMethod("initialize","variable.Integral",
+          function(.Object,
+                   var.dx = character(),
+                   lower.var = character(),
+                   upper.var = character(),
+                   out.var = character(),
+                   var.time = character()){
+            .Object at var.dx <- var.dx
+            .Object at lower.var <- lower.var
+            .Object at upper.var <- upper.var
+            .Object at out.var <- out.var
+            .Object at var.time <- var.time
+            return(.Object)
+          }
+          )
+
+#   Integrand
+#     Integral$IntegrandList
+#     Integral$dimIntegrand
+
+setClass("Integrand",
+         representation(IntegrandList = "list",
+                        dimIntegrand = "numeric")
+         )
+setMethod("initialize","Integrand",
+          function(.Object,
+                   IntegrandList = list(),
+                   dimIntegrand = numeric()){
+            .Object at IntegrandList <- IntegrandList
+            .Object at dimIntegrand <- dimIntegrand
+            return(.Object)
+          }
+          )
+#
+# #   Integral.sde
+#
+setClass("Integral.sde", representation(param.Integral = "param.Integral",
+                                        variable.Integral = "variable.Integral", Integrand = "Integrand")
+)
+#
+setMethod("initialize", "Integral.sde",
+          function(.Object,
+                   param.Integral = new("param.Integral"),
+                   variable.Integral = new("variable.Integral"),
+                   Integrand = new("Integrand")){
+            .Object at param.Integral <- param.Integral
+            .Object at variable.Integral <- variable.Integral
+            .Object at Integrand <- Integrand
+            return(.Object)
+          }
+)
+#
+# # yuima.Integral
+#
+setClass("yuima.Integral", representation(
+  Integral = "Integral.sde"),
+  contains = "yuima"
+)
+#
+setMethod("initialize", "yuima.Integral",
+          function(.Object,
+                   Integral = new("Integral.sde"),
+                   yuima = new("yuima")){
+            .Object at Integral <- Integral
+            #.Object at param <- param
+            #.Object at Output <- Output
+            .Object at data <- yuima at data
+            .Object at model <- yuima at model
+            .Object at sampling <- yuima at sampling
+            .Object at characteristic <- yuima at characteristic
+            .Object at functional <- yuima at functional
+            return(.Object)
+          }
+)
+#
+
+
+# yuima.multimodel. We replacate the yuima.model class in order to
+# describe from mathematical point of view the multi dimensional jump
+# diffusion model
+setClass("yuima.multimodel",
+         contains="yuima.model")
+
+setClass("yuima.snr", representation(call = "call", coef = "numeric", snr = "numeric", model = "yuima.model"), prototype = list(call = NULL, coef = NULL, snr = NULL, model = NULL))
+
+## yuima.qmle.incr-class
+#setClassUnion("yuima.qmle.incr", members=c("yuima.carma.qmle","cogarch.est.incr"))
+setClass("yuima.qmleLevy.incr",representation(Incr.Lev = "ANY",
+                                              logL.Incr = "ANY",
+                                              minusloglLevy="function",
+                                              Levydetails= "list",
+                                              Data = "ANY"),
+         contains="yuima.qmle")
+
+setMethod("initialize", "yuima.qmleLevy.incr",
+          function(.Object,
+                   Incr.Lev = NULL,
+                   logL.Incr = NULL,
+                   minusloglLevy=function(){NULL},
+                   Levydetails= list(),
+                   Data=NULL,
+                   yuima = new("yuima.qmle")){
+            .Object at Incr.Lev <- Incr.Lev
+            #.Object at param <- param
+            #.Object at Output <- Output
+            .Object at logL.Incr <- logL.Incr
+            .Object at Levydetails<- Levydetails
+            .Object at minusloglLevy <- minusloglLevy 
+            .Object at Data <- Data
+            .Object at model <- yuima at model
+            .Object at call <- yuima at call
+            .Object at coef <- yuima at coef
+            .Object at fullcoef <- yuima at fullcoef
+            .Object at vcov <- yuima at vcov
+            .Object at min <-yuima at min
+            .Object at details<- yuima at details
+            .Object at minuslogl<-yuima at minuslogl
+            .Object at nobs<-yuima at nobs
+            .Object at method<-yuima at method
+            return(.Object)
+          }
+)
+

Modified: pkg/yuima/R/qmleLevy.R
===================================================================
--- pkg/yuima/R/qmleLevy.R	2020-02-20 19:38:02 UTC (rev 722)
+++ pkg/yuima/R/qmleLevy.R	2020-02-26 21:53:03 UTC (rev 723)
@@ -7,6 +7,8 @@
                    Est.Incr = c("NoIncr","Incr","IncrPar"),
                    aggregation = TRUE)
 {
+  call <- match.call()
+  truestart<-start
   cat("\nStarting QGMLE for SDE ... \n")
   parameter<-yuima at model@parameter at all
   orig.mylaw<-yuima at model@measure
@@ -267,8 +269,22 @@
       
       res <- list(first = fres at coef, second = sres at coef, third = tres at coef)
     }else if((length(ovp) > 0) || !(third)){
-      res <- list(first = fres at coef, second = sres at coef)}
-    else{
+      coef<-c(sres at coef,fres at coef)
+      mycoef<-unlist(truestart)
+      #mycoef1<-mycoef[names(coef)]
+      mycoef2<-mycoef[!names(mycoef)%in%names(coef)]
+      mycoef<-c(coef,mycoef2)
+      vcov0<-matrix(NA,nrow = length(coef),ncol=length(coef))
+      rownames(vcov0)<-names(coef)
+      colnames(vcov0)<-names(coef)
+      min0<- c(fres at min,sres at min)
+      details0<-list(sres at details,fres at details)
+      nobs0<-sres at nobs
+      res<-new("yuima.qmle", call = call, coef = coef, fullcoef = mycoef,
+                     vcov = vcov0, min = min0, details = details0, minuslogl = minusquasilogl,
+                     method = sres at method, nobs=nobs0, model=sdeModel)
+      # res <- list(first = fres at coef, second = sres at coef)}
+    }else{
       yuima.stop("third estimation may be theoretical invalid under the presence of an overlapping parameter.")
     }
   }else{
@@ -319,17 +335,17 @@
   modelstate<-yuima at model@solve.variable
   tmp.env<-new.env()
   
-  if(joint){
+  #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]])
-      }
-    }
-    
-  }
+  # }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))
@@ -460,8 +476,28 @@
   }
   
   
+  if(aggregation){
+    if(!is.matrix(res.incr)){
+      res.incr<- as.matrix(res.incr)
+    }
+    if(dim(res.incr)[2]==1){
+      colnames(res.incr)<-sdeModel at jump.variable
+    }else{
+      colnames(res.incr)<-paste0(sdeModel at jump.variable,c(1:dim(res.incr)[2]))
+    }
+    Incr.Lev <- zooreg(data=res.incr)
+    Incr.Lev<- setData(original.data = Incr.Lev,)
+  }else{
+    Incr.Lev <- zoo(res.incr,order.by=yuima at sampling@grid[[1]][-1])
+    Incr.Lev <- setData(original.data=Incr.Lev)
+  }
+  
   if(Est.Incr == "Incr"){
-    return(list(res=res,Est.Incr=res.incr))
+    
+      
+    result<- new("yuima.qmleLevy.incr",Incr.Lev=Incr.Lev,
+                 Data = yuima at data,  yuima=res)
+    return(result)
   }
   cat("\nEstimation Levy parameters ... \n")
   
@@ -486,7 +522,21 @@
     upperjump <- upper0[lev.names]
     esti <- optim(fn = minusloglik, lower = lowerjump, upper = upperjump, 
                   par = para, method = "L-BFGS-B")
-    return(list(res=res,Est.Incr=res.incr, meas=esti$par))
+    #optimHess(par=esti$par, fn=minusloglik)
+    res at coef<-c(res at coef,esti$par)
+    res at fullcoef[names(para)]<-esti$par
+    res at vcov<-cbind(res at vcov,matrix(NA,ncol=length(esti$par),nrow=dim(res at vcov)[1]))
+    colnames(res at vcov)<-names(res at fullcoef)
+    res at vcov<-rbind(res at vcov,matrix(NA,nrow=length(esti$par),ncol=dim(res at vcov)[2]))
+    rownames(res at vcov)<-names(res at fullcoef)
+    res at min<-c(res at min,esti$value)
+    res at nobs<-c(res at nobs,length(Incr.Lev at zoo.data[[1]]))
+    
+    result<- new("yuima.qmleLevy.incr",Incr.Lev=Incr.Lev,
+                 minusloglLevy = minusloglik,logL.Incr=-esti$value,
+                 Data = yuima at data,  yuima=res, Levydetails=esti)
+    
+    return(result)
     }else{
       dist <- substr(as.character(orig.mylaw$df$expr), 2, 10^3)
   

Added: pkg/yuima/man/yuima.qmleLevy.incr-class.Rd
===================================================================
--- pkg/yuima/man/yuima.qmleLevy.incr-class.Rd	                        (rev 0)
+++ pkg/yuima/man/yuima.qmleLevy.incr-class.Rd	2020-02-26 21:53:03 UTC (rev 723)
@@ -0,0 +1,39 @@
+\name{yuima.qmleLevy.incr}
+\docType{class}
+\alias{yuima.qmleLevy.incr-class}
+\alias{yuima.qmleLevy.incr,ANY-method}
+\alias{initialize,yuima.qmleLevy.incr-method}
+\alias{qmleLevy.incr}
+\alias{incr.qmleLevy}
+
+\title{Class for Quasi Maximum Likelihood Estimation of Levy SDE model}
+\description{
+  The \code{yuima.qmleLevy.incr-class} is a class of the  \pkg{yuima} package that extends the \code{mle-class} of the \pkg{stats4} package.  
+}
+\section{Slots}{
+  \describe{
+    \item{\code{Incr.Lev}:}{is an object of class \code{\link{yuima.data-class}} that contains the estimated increments of the noise.}
+    \item{\code{logL.Incr}:}{an numeric object that represents the value of the loglikelihood for the estimated Levy increments.}
+    \item{\code{minusloglLevy}:}{an R function that evaluates the loglikelihood of the estimated Levy increments. The function is used internally in \code{\link{qmleLevy}} for the estimation of the Levy measure parameters.}
+    \item{\code{Levydetails}:}{a \code{list} containing additional information about the optimization procedure in the estimation of the Levy measure parameters. See \code{\link{optim}} help for the meaning of the components of this \code{list}.}
+      \item{\code{Data}:}{is an object of \code{\link{yuima.data-class}} containing observation data.}
+    \item{\code{model}:}{is an object of of \code{\link{yuima.carma-class}}.}
+    \item{\code{call}:}{is an object of class \code{language}. }
+    \item{\code{coef}:}{is an object of class \code{numeric} that contains estimated parameters.}
+    \item{\code{fullcoef}:}{is an object of class \code{numeric} that contains estimated and fixed parameters.}
+    \item{\code{vcov}:}{is an object of class \code{matrix}.}
+    \item{\code{min}:}{is an object of class \code{numeric}.}
+    \item{\code{minuslogl}:}{is an object of class \code{function}.}
+    \item{\code{nobs}:}{an object of class \code{numeric}.}
+    \item{\code{method}:}{is an object of class \code{character}.}
+  }
+}
+\section{Methods}{
+  \describe{
+    \item{Methods mle}{All methods for \code{mle-class} are available.}
+  }
+}
+\author{The YUIMA Project Team}
+\keyword{classes}
+
+



More information about the Yuima-commits mailing list