version 1.0.21

DESCRIPTION

@@ -1,16 +1,16 @@
 Package: yuima
 Type: Package
 Title: The YUIMA Project package for SDEs
-Version: 1.0.10
-Date: 2014-04-22
+Version: 1.0.21
+Date: 2014-05-02
 Depends: methods, zoo, stats4, utils, expm
 Suggests: cubature, mvtnorm
 Author: YUIMA Project Team
-Maintainer: Stefano M. Iacus <stefano.iacus@unimi.it>
+Maintainer: Stefano Maria Iacus <stefano.iacus@unimi.it>
 Description: Simulation and Inference for Stochastic Differential Equations
 License: GPL-2
 URL: http://R-Forge.R-project.org/projects/yuima/
-Packaged: 2014-04-22 08:22:41 UTC; jago
+Packaged: 2014-05-05 05:13:59 UTC; jago
 NeedsCompilation: yes
 Repository: CRAN
-Date/Publication: 2014-04-22 10:36:37
+Date/Publication: 2014-05-05 07:48:26

MD5

@@ -1,29 +1,29 @@
 94d55d512a9ba36caa9b7df079bae19f *COPYING
-488233956020d352537ee385fe7baf2e *DESCRIPTION
-1b31a8ac48ac8d68cf933385fae31cc9 *NAMESPACE
-9350d490863ce066c694999306acb0c4 *NEWS
+71db86268aa371eee66aff1f5f715bb0 *DESCRIPTION
+071e3fda8ed81bb9e96adf503677b071 *NAMESPACE
+4c9bab55970e89785f8e5fb08788925f *NEWS
 88f93f4a6f4f1891c2efa763a8368caf *R/AllClasses.R
-10af31dabef9c78bcb1bcdae2b858598 *R/CPoint.R
-c1446cbd041c657aa8cfa910681e173f *R/CarmaNoise.R
+ecfdd33974bed758ee54d2ec06ce2232 *R/CPoint.R
+49eb6b85e1313ab3a26781c3c70bc192 *R/CarmaNoise.R
 4b3325c594164c1ef9e617555903b7ec *R/CholeskyfGn.R
 124b71a14243eff366bfa88280226965 *R/WoodChanfGn.R
 ade733cf8fce4b255d386c50265cab77 *R/adaBayes.R
 c1c7976024dade86faeb4c20ebc8ca51 *R/asymptotic_term_second.R
 45e8fcaef8cc69ec83fc897c19fef5ee *R/asymptotic_term_third.R
 a2e9dba4d2ab571053806a3463dd0157 *R/asymptotic_term_third_function.R
 3878b53ad6b45165671e6992e19bcced *R/bns.test.R
-250e53b01e8a79f69319c92dc95eaf94 *R/cce.R
-9dee0c0188986feafbaa0920600824e2 *R/lasso.R
+be74573aa14795bf124f04706a3c612c *R/cce.R
+febfb56c6f3c5e1d41854337c9ec5e00 *R/lasso.R
 80a34e4a1f572dd2115686cee71be223 *R/limiting.gamma.R
-be78707367e530dc14e27e0132167feb *R/llag.R
+90181caa4b53a457f6d8a7609ec73e36 *R/llag.R
 f6ab699bac600a3e5955f46962c224c4 *R/lse.R
 8dff29b07d75ba4703870061db483f75 *R/mmfrac.R
 70759bc971fc6d2b6b15fc8ec668a894 *R/mpv.R
 ee94a80376999cb09d7a5c984b520687 *R/noisy.sampling.R
 e920d4330c561d82faa6695675da2d3b *R/phi.test.R
 197ae3a057ce2b8309af7c30a30f3337 *R/poisson.random.sampling.R
 6590dec2df8596e6bb2309d9221d29bc *R/qgv.R
-8a932664af5815f568f66c3273f6bfc8 *R/qmle.R
+7be3d2398dca1264f93b1ed6ec97bc4f *R/qmle.R
 a81676b55b502aad5f261b664680f537 *R/rng.R
 1f567847cf9c65fa085f2f9a50d3e8e6 *R/sampling2grid.R
 b51ccb32c0eb42f1f41a2cb0f9146e32 *R/setCarma.R
@@ -33,18 +33,20 @@ d6d8dbbbeb5b8950787d890e953d38ed *R/sim.euler.space.discretized.R
 4c491167e360daeb4b34816c979b9f8f *R/simulate.R
 f506cf2d30a5f912b5221112d7ae8965 *R/subsampling.R
 074dc2d814dee60f80b59ba5014cff4d *R/toLatex.R
-f8b1e52fda98c6f6128ce9ea1551f4bd *R/yuima.R
+8a1e83a18bb61ab36e9abc97fc6c6457 *R/yuima.R
 edfabacecae0ebb9b40324f1d499b4b9 *R/yuima.characteristic.R
-519671a9de55db57f8cf57a8e05d7613 *R/yuima.data.R
+e5347ae9c63c878226d4e14d20638cf5 *R/yuima.data.R
 56a8471869f97e9fb2e53ce8d5ce3252 *R/yuima.functional.R
 00b08aaaad567e676ada82c567893b06 *R/yuima.model.R
 f75a561a3ff0ff4955bcd329128e1e2e *R/yuima.sampling.R
 c1ee1ff8bddedff2f1dd24eeb10782c3 *R/zzz.R
+bce7107dc324a66a94865b56f9e3bbf3 *data/MWK151.rda
 ba391af8d40ef453c6d0a726d4170ffa *inst/AUTHORS
 c39fee5ae7e8ac95f0d0e32290b8da46 *inst/CITATION
 cd8687c920284fc3afb12b9638fa70d2 *inst/COPYRIGHTS
 1c61255f47e28af617c8eee89bc652b3 *man/CPoint.Rd
 2ff567959c3646587b4eea7855f3fd40 *man/CarmaNoise.Rd
+055e9a102fcf02b4f9419311839f5675 *man/MWK151.Rd
 8d58fd161183296785e5b46c700957cb *man/adaBayes.Rd
 246cfd2ae45d70a7082f4ca558a946a3 *man/asymptotic_term.Rd
 cd4c530aef0469d9b86787b2dd843bcd *man/bns.test.Rd
@@ -53,14 +55,14 @@ d3a8b9c61dcbd7bba509401886329b9c *man/carma.info-class.Rd
 bc7cde41c45c90f70d5e39e4363ebbb3 *man/lasso.Rd
 83b71e10610d8835a34015fafd55363c *man/limiting.gamma.Rd
 6dfe9e9746801fc034e6ea531d6cfd8b *man/llag.Rd
-690314aa60f24feb7fb8c754b4b18950 *man/mmfrac.Rd
+569c693d7c318a71b2da6969f4ea0052 *man/mmfrac.Rd
 854eef2bdc9e5c4fbe61e78c5f671843 *man/model.parameter-class.Rd
 4f5e4bc68063c3660d9631ae7815a18f *man/mpv.Rd
 7440d3438479efc0b88121047b884086 *man/noisy.sampling.Rd
 1e62c8b5975366714ae0a052acb8b41c *man/phi.test.Rd
 7566b9ac61bee8350513827f37448cb7 *man/poisson.random.sampling.Rd
 b3165cb5569c8200e1951475a788de29 *man/qgv.Rd
-7cbaab2e37291e4ee052d32610aa4d0f *man/qmle.Rd
+8b27ce8bddfee4369f4147f29e587860 *man/qmle.Rd
 3a21c90c366ccae181e12b2d671541f5 *man/rng.Rd
 462fdc39ca445291aa57448f8fa5b201 *man/setCarma.Rd
 ad4ddfb720691c328760854eda4d505b *man/setCharacteristic.Rd

NAMESPACE

@@ -63,6 +63,7 @@ export(setData)
 export(setSampling)
 export(setCharacteristic)
 export(setCarma)
+
 
 export(dim)
 export(length)
@@ -122,10 +123,12 @@ export(cbind.yuima)
 S3method(print, phitest)
 S3method(print, qgv)
 S3method(print, mmfrac)
+S3method(print, yuima.lasso)
 
 S3method(toLatex, yuima)
 S3method(toLatex, yuima.model)
 S3method(toLatex, yuima.carma)
+
 
 useDynLib(yuima)
 

NEWS

@@ -16,4 +16,6 @@
 2013/10/28: modify llag.R
 2013/10/30: modify cce.R, cce_functions.c
 2013/11/21: modify llag.R
-2013/11/22: modify cce.R, cce_functions.c
+2013/11/22: modify cce.R, cce_functions.c
+2014/04/28: modified qmle, added carma, modified lasso
+2014/05/04: modified show method, setYuima sets the sampling from the data if sampling is missing

R/CPoint.R

@@ -77,6 +77,9 @@ pminusquasilogl <- function(yuima, param, print=FALSE, env){
 
 	nm <- names(param)
     oo <- match(nm, fullcoef)
+    if(any(is.na(oo)))
+     oo <- oo[-which(is.na(oo))]
+
     if(any(is.na(oo))) 
 		yuima.stop("some named arguments in 'param' are not arguments to the supplied yuima model")
 

R/CarmaNoise.R

@@ -207,7 +207,7 @@ CarmaNoise<-function(yuima, param, data=NULL,NoNeg.Noise=FALSE){
 
   levy<-yuima.CarmaNoise(y,tt,ar.par,ma.par, loc.par, scale.par, lin.par,NoNeg.Noise)
   inc.levy<-diff(as.numeric(levy))
-  return(inc.levy)
+  return(inc.levy[-1]) #We start to compute the increments from the second observation. 
 }
 
 

R/cce.R

@@ -2646,6 +2646,9 @@ if(d.size>1){
 }else{
   cormat <- as.matrix(1)
 }
-
+rownames(cmat) <- names(data)
+colnames(cmat) <- names(data)
+rownames(cormat) <- names(data)
+colnames(cormat) <- names(data)
 return(list(covmat=cmat,cormat=cormat))
 })

R/lasso.R

@@ -2,14 +2,21 @@
 # fixes a small bug in passing arguments to the
 # inner optim function
 
-lasso <- function (yuima, lambda0, start, delta = 1, ...) 
+lasso <- function (yuima, lambda0, start, delta = 1, ...)
 {
     call <- match.call()
     if (missing(yuima)) 
     yuima.stop("yuima object 'yuima' is missing.")
+    pars <- yuima@model@parameter@all
+    npars <- length(pars)
     if (missing(lambda0)) {
-        pars <- yuima@model@parameter@all
-        lambda0 <- rep(1, length(pars))
+        lambda0 <- rep(1, npars)
+        names(lambda0) <- pars
+        lambda0 <- as.list(lambda0)
+    }
+    if(!is.list(lambda0)){
+        lambda0 <- as.numeric(lambda0)
+        lambda0 <- as.numeric(matrix(lambda0, npars,1))
         names(lambda0) <- pars
         lambda0 <- as.list(lambda0)
     }
@@ -18,16 +25,26 @@ lasso <- function (yuima, lambda0, start, delta = 1, ...)
     fail <- lapply(lambda0, function(x) as.numeric(NA))
     cat("\nLooking for MLE estimates...\n")
     fit <- try(qmle(yuima, start = start, ...), silent = TRUE)
-    if (class(fit) == "try-error") 
-    return(list(mle = fail, sd.mle = NA, lasso = fail, sd.lasso = NA))
+    if (class(fit) == "try-error"){
+      tmp <- list(mle = fail, sd.mle = NA, lasso = fail, sd.lasso = NA)
+      class(tmp) <- "yuima.lasso"
+      return(tmp)
+    }
     theta.mle <- coef(fit)
     SIGMA <- try(sqrt(diag(vcov(fit))), silent = TRUE)
-    if (class(SIGMA) == "try-error") 
-    return(list(mle = theta.mle, sd.mle = NA, lasso = fail, sd.lasso = NA))
+    if (class(SIGMA) == "try-error"){
+     tmp <- list(mle = theta.mle, sd.mle = NA, lasso = fail, sd.lasso = NA)
+     class(tmp) <- "yuima.lasso"
+     return(tmp)
+    }
+
     H <- try(solve(vcov(fit)), silent = TRUE)
-    if (class(H) == "try-error") 
-    return(list(mle = theta.mle, sd.mle = SIGMA, lasso = fail, sd.lasso = NA))
-
+    if (class(H) == "try-error"){
+      tmp <- list(mle = theta.mle, sd.mle = SIGMA, lasso = fail, sd.lasso = NA)
+      class(tmp) <- "yuima.lasso"
+      return(tmp)
+    }
+
     lambda <- unlist(lambda0[names(theta.mle)])/abs(theta.mle)^delta
 
     #lambda1 <- unlist(lambda0[names(theta.mle)])/abs(theta.mle)
@@ -48,79 +65,46 @@ lasso <- function (yuima, lambda0, start, delta = 1, ...)
     fit2 <- try( do.call(optim, args = args), silent = TRUE)
 
 
-    if (class(fit2) == "try-error") 
-    return(list(mle = theta.mle, sd.mle = SIGMA, lasso = fail, sd.lasso = NA))
+    if (class(fit2) == "try-error"){
+      tmp <- list(mle = theta.mle, sd.mle = SIGMA, lasso = fail, sd.lasso = NA)
+      class(tmp) <- "yuima.lasso"
+      return(tmp)
+    }
     theta.lasso <- fit2$par
     SIGMA1 <- try(sqrt(diag(solve(fit2$hessian))), silent = TRUE)
-    if (class(SIGMA1) == "try-error") 
-    return(list(mle = theta.mle, sd.mle = SIGMA, lasso = theta.lasso, 
-    sd.lasso = NA))
-    return(list(mle = theta.mle, sd.mle = SIGMA, lasso = theta.lasso, 
-    sd.lasso = SIGMA1, call = call, lambda0 = lambda0))
+    if (class(SIGMA1) == "try-error"){
+      tmp <- list(mle = theta.mle, sd.mle = SIGMA, lasso = theta.lasso,
+    sd.lasso = NA)
+      class(tmp) <- "yuima.lasso"
+      return(tmp)
+    }
+
+    tmp <- list(mle = theta.mle, sd.mle = SIGMA, lasso = theta.lasso,
+    sd.lasso = SIGMA1, call = call, lambda0 = lambda0)
+    class(tmp) <- "yuima.lasso"
+    return(tmp)
+
 }
 
-# removed version
-old.lasso <- function(yuima, lambda0, start, delta=1, ...){
-
-	call <- match.call()
-
-	if( missing(yuima))
-		yuima.stop("yuima object 'yuima' is missing.")
-
-	if( missing(lambda0) ){
-	 pars <- yuima@model@parameter@all	
-	 lambda0 <- rep(1, length(pars))
-	 names(lambda0) <- pars
-	 lambda0 <- as.list(lambda0)	
-	}
-
-## FIXME: maybe we should choose initial values at random within lower/upper
-##        at present, qmle stops	
-	if( missing(start) ) 
-		yuima.stop("Starting values for the parameters are missing.")
-
-	fail <- lapply(lambda0, function(x) as.numeric(NA))
-
-	cat("\nLooking for MLE estimates...\n")
-	fit <- try(qmle(yuima, start=start,...), silent=TRUE)
-	if(class(fit)=="try-error")
-	return(list(mle=fail, sd.mle=NA, lasso=fail, sd.lasso=NA))
-
-	SIGMA <- try( sqrt(diag(vcov(fit))), silent=TRUE)
-	if(class(SIGMA)=="try-error")
-	return(list(mle=fail, sd.mle=NA, lasso=fail, sd.lasso=NA))
-
-
-	theta.mle <- coef(fit)
-
-	H <- try( solve(vcov(fit)), silent=TRUE) 
-
-	if(class(H)=="try-error")
-	return(list(mle=fail, sd.mle=NA, lasso=fail, sd.lasso=NA))
-
-
-#	lambda <- unlist(lambda0[names(theta.mle)])/abs(theta.mle)
-	lambda <- unlist(lambda0[names(theta.mle)])/abs(theta.mle)^delta
-    lambda1 <- unlist(lambda0[names(theta.mle)])/abs(theta.mle)
-	idx <- which(lambda>1e4)
-	lambda[idx] <- 1e4 # lambda1[idx]
-
-	f2 <- function( theta ) as.numeric( t(theta-theta.mle) %*% H %*% (theta-theta.mle) + lambda %*% abs(theta) )
-
-	cat("\nPerforming LASSO estimation...\n")
-
-	fit2 <- try( optim(theta.mle, f2, hessian=TRUE,..., 
-					   control = list(maxit=30000, temp=2000, REPORT=500)), silent=TRUE) 
-	if(class(fit2)=="try-error")
-	return(list(mle=fail, sd.mle=NA, lasso=fail, sd.lasso=NA))
-
-	theta.lasso <- fit2$par
-
-	SIGMA1 <- try(sqrt(diag(solve(fit2$hessian))), silent=TRUE)
-
-	if(class(SIGMA1)=="try-error")
-	return(list(mle = theta.mle, sd.mle = NA, lasso = theta.lasso, sd.lasso = NA))
-#	return(list(mle=fail, sd.mle=NA, lasso=fail, sd.lasso=NA))
-
-	return(list(mle=theta.mle, sd.mle=SIGMA, lasso=theta.lasso, sd.lasso=SIGMA1,call=call, lambda0=lambda0))
+
+
+
+print.yuima.lasso <- function(x,...){
+    cat("Adaptive Lasso estimation\n")
+    cat("\nCall:\n")
+    print(x$cal)
+    if(!is.null(x$mle) & !is.null(x$sd.mle)){
+        qmle.tab <- rbind(x$mle, x$sd.mle)
+        rownames(qmle.tab) <- c("Estimate", "Std. Error")
+        cat("\nQMLE estimates\n")
+        print(t(qmle.tab))
+    }
+
+    if(!is.null(x$lasso) & !is.null(x$sd.lasso)){
+        lasso.tab <- rbind(x$lasso, x$sd.lasso)
+        rownames(lasso.tab) <- c("Estimate", "Std. Error")
+        cat("\nLASSO estimates\n")
+        print(t(lasso.tab))
+    }
 }
+

R/llag.R

@@ -204,8 +204,14 @@ setMethod( "llag", "yuima.data", function(x,from=-Inf,to=Inf,division=FALSE,
   }
 
   cormat <- diag(1/sqrt(diag(covmat)))%*%covmat%*%diag(1/sqrt(diag(covmat)))
-
+  colnames(theta) <- names(zdata)
+  rownames(theta) <- names(zdata)
+
   if(verbose==TRUE){
+    colnames(covmat) <- names(zdata)
+    rownames(covmat) <- names(zdata)
+    colnames(cormat) <- names(zdata)
+    rownames(cormat) <- names(zdata)
     return(list(lagcce=theta,covmat=covmat,cormat=cormat,crosscov=crosscov))
   }else{
     return(theta)
@@ -353,7 +359,6 @@ setMethod( "llag", "yuima.data", function(x,from=-Inf,to=Inf,division=FALSE,verb
 
   #  covmat <- lagcce(dat@zoo.data,theta)
   cormat <- diag(1/sqrt(diag(covmat)))%*%covmat%*%diag(1/sqrt(diag(covmat)))
-
   if(verbose==TRUE){
     return(list(lagcce=theta,covmat=covmat,cormat=cormat))
   }else{