Skip to content

Commit

Permalink
version 1.0.78
Browse files Browse the repository at this point in the history
  • Loading branch information
@siacus @cran-robot
siacus authored and cran-robot committed Jan 14, 2016
1 parent 10403c0 commit 49eda69
Show file tree
Hide file tree
Showing 9 changed files with 279 additions and 115 deletions.
6 changes: 3 additions & 3 deletions DESCRIPTION
View file
Original file line number Diff line number Diff line change
@@ -1,7 +1,7 @@
Package: yuima
Type: Package
Title: The YUIMA Project Package for SDEs
Version: 1.0.77
Version: 1.0.78
Depends: R(>= 2.10.0), methods, zoo, stats4, utils, expm, cubature,
mvtnorm
Author: YUIMA Project Team
Expand All @@ -10,6 +10,6 @@ Description: Simulation and Inference for Stochastic Differential Equations.
License: GPL-2
URL: http://R-Forge.R-project.org/projects/yuima/
NeedsCompilation: yes
Packaged: 2015-11-20 13:19:41 UTC; jago
Packaged: 2016-01-14 09:50:34 UTC; jago
Repository: CRAN
Date/Publication: 2015-11-20 18:08:08
Date/Publication: 2016-01-14 11:24:13
16 changes: 8 additions & 8 deletions MD5
View file
Original file line number Diff line number Diff line change
@@ -1,7 +1,7 @@
94d55d512a9ba36caa9b7df079bae19f *COPYING
e91542080b651f68780a4766cebf92c0 *DESCRIPTION
58c429c2881912e7b9232155b49e3640 *DESCRIPTION
1a1147f8512e8664555c3c3f7e4e2791 *NAMESPACE
711fe8fc70eaa7b4a18992ba8f79df0e *NEWS
f19743a7aa2c27b296771c8d2c3d7372 *NEWS
86f3ae6987c8a36c75b0be09a879ed5c *R/AllClasses.R
ecfdd33974bed758ee54d2ec06ce2232 *R/CPoint.R
dd610167315ee57f6b5921a5da017867 *R/CarmaNoise.R
Expand Down Expand Up @@ -31,7 +31,7 @@ e920d4330c561d82faa6695675da2d3b *R/phi.test.R
197ae3a057ce2b8309af7c30a30f3337 *R/poisson.random.sampling.R
dccb8679a411fb8e915736c8510f710e *R/qgv.R
3b2c6d05f70f82903d2698bd4f32edf1 *R/qmle.R
ed6b747c418179641c5a60187aa38ec3 *R/rng.R
a289599bcc62d5807bcf620b12ea15af *R/rng.R
1f567847cf9c65fa085f2f9a50d3e8e6 *R/sampling2grid.R
6b59a2f01c61e56fc36165759434a326 *R/setCarma.R
5426f7206ebb290a6d3fc11729dbb6c7 *R/setCogarch.R
Expand Down Expand Up @@ -61,7 +61,7 @@ cd8687c920284fc3afb12b9638fa70d2 *inst/COPYRIGHTS
f6cedc6c81529d87e7e7bdad57f28308 *man/Diagnostic.Cogarch.Rd
14addf8dd1e42e51dad008b6d0c85532 *man/LogSPX.Rd
33b5307defeed5658299f5aec563673e *man/MWK151.Rd
8d58fd161183296785e5b46c700957cb *man/adaBayes.Rd
20e9e7e07168880ee42e2d58fa6817f6 *man/adaBayes.Rd
246cfd2ae45d70a7082f4ca558a946a3 *man/asymptotic_term.Rd
cd4c530aef0469d9b86787b2dd843bcd *man/bns.test.Rd
d3a8b9c61dcbd7bba509401886329b9c *man/carma.info-class.Rd
Expand All @@ -83,21 +83,21 @@ db5127cc4b6ee0cd2ab9f40e52341477 *man/mpv.Rd
1e62c8b5975366714ae0a052acb8b41c *man/phi.test.Rd
7566b9ac61bee8350513827f37448cb7 *man/poisson.random.sampling.Rd
b3165cb5569c8200e1951475a788de29 *man/qgv.Rd
4fdbce9541dee32adde1f9c292332208 *man/qmle.Rd
eca9516651005563f1adc542769c02e0 *man/qmle.Rd
361abb4eb2b5e1fac3c9513b27e7623e *man/rconst.Rd
3a21c90c366ccae181e12b2d671541f5 *man/rng.Rd
a1d60f3bf192ee41b668a291b85b9a08 *man/rng.Rd
dcf545cfcafb3d4db450cb64d0ee46ad *man/setCarma.Rd
ad4ddfb720691c328760854eda4d505b *man/setCharacteristic.Rd
4767b968b3807fbe8b7ea54ecaa54aa4 *man/setCogarch.Rd
3553554d6bd21880a43ca82082b7c212 *man/setData.Rd
85e350be0518275991a13c21e6f2723f *man/setFunctional.Rd
a0478e917fe2724c571982606bfe2fce *man/setModel.Rd
b8f4403135dff3222c09eb340fc8fe10 *man/setModel.Rd
c1679f065c110af4e9520971454fb65b *man/setPoisson.Rd
0512596ff48ff056083590f1a6b0fe3f *man/setSampling.Rd
9472c984217193e30caa73d6520b719f *man/setYuima.Rd
ab5b290fd33ce465c9c035d49995ce77 *man/simFunctional.Rd
a155b6054ee3712125c1b4f1ec92fedd *man/simulate.Rd
89ab6ccbb241986b03ed074e6650a1cd *man/spectralcov.Rd
c79ad460bb5329d3c28e3f00e4430b46 *man/spectralcov.Rd
114989e6fbd3d202b0f3a6650a019abb *man/subsampling.Rd
288e38afe2b8d2975833ef2cfe62e70a *man/toLatex.Rd
4d6967e5c90892209f7bb705f20206dc *man/yuima-class.Rd
Expand Down
3 changes: 2 additions & 1 deletion NEWS
View file
Original file line number Diff line number Diff line change
Expand Up @@ -37,4 +37,5 @@
add some contents to the examples of cce
2015/10/10: modified llag.R, cce.Rd, llag.Rd, mpv.Rd, noisy.sampling.Rd, cce_functions.c
added mllag.R, mllag.Rd (multiple lead-lag detector);
spectralcov.R, spectralcov.Rd (spectral covariance estimator)
spectralcov.R, spectralcov.Rd (spectral covariance estimator)
2016/01/14: modified rng.R, rng.Rd, adaBayes.Rd, qmle.Rd, setModel.Rd, spectralcov.Rd
210 changes: 141 additions & 69 deletions R/rng.R
View file
Original file line number Diff line number Diff line change
@@ -1,7 +1,6 @@
##################################################################
###### "Random number generators and
###### related density functions for yuima packages"
###### (Last modified: Apr 2, 2015)
##################################################################


Expand All @@ -20,6 +19,31 @@ rbgamma <- function(x,delta.plus,gamma.plus,delta.minus,gamma.minus){
return(X)
}

# "dbgamma" by YU.
dbgamma<-function(x,delta.plus,gamma.plus,delta.minus,gamma.minus){
## Error check
if(length(delta.plus)!=1||length(gamma.plus)!=1||length(delta.minus)!=1||length(gamma.minus)!=1)
stop("All of the parameters are numeric.")
if(delta.plus<=0||gamma.plus<=0||delta.minus<=0||gamma.minus<=0)
stop("All of the parameters are positive.")

## On the positive line
funcp<-function(x,y){y^{delta.minus-1}*(x+y/(gamma.plus+gamma.minus))^{delta.plus-1}*exp(-y)}
intp<-function(x){integrate(funcp,lower=0,upper=Inf,x=x)$value}
intvecp<-function(x)sapply(x,intp)
densp<-gamma.plus^delta.plus*gamma.minus^delta.minus/((gamma.plus+gamma.minus)^delta.minus*gamma(delta.plus)*gamma(delta.minus))*exp(-gamma.plus*x)*intvecp(x)

## On the negative line
funcm<-function(x,y){y^{delta.plus-1}*(-x+y/(gamma.plus+gamma.minus))^{delta.minus-1}*exp(-y)}
intm<-function(x){integrate(funcm,lower=0,upper=Inf,x=x)$value}
intvecm<-function(x)sapply(x,intm)
densm<-gamma.plus^delta.plus*gamma.minus^delta.minus/((gamma.plus+gamma.minus)^delta.plus*gamma(delta.minus)*gamma(delta.plus))*exp(gamma.minus*x)*intvecm(x)

dens<-ifelse(0<=x,densp,densm)
dens

}


## (Multivariate) Normal gamma

Expand Down Expand Up @@ -61,12 +85,14 @@ rngamma <- function(x,lambda,alpha,beta,mu,Lambda){
if( nrow(Lambda)!=length(beta)){
stop("Dimension of Lambda and beta must be equal.")
}
if( sum(eigen(Lambda)$values <= 0 ) > 0){

if( min(eigen(Lambda)$value) <= 10^(-15) ){
stop("Lambda must be positive definite.")
}
if( det(Lambda) < 10^(-15)){
stop("Determinant of Lambda must be one.")
if( det(Lambda) > 1+10^(-15) || det(Lambda) < 1-10^(-15) ){
stop("The determinant of Lambda must be 1.")
}

tmp <- as.numeric(alpha^2 - t(beta) %*% Lambda %*% beta)

if( lambda <= 0 )
Expand All @@ -88,58 +114,52 @@ rngamma <- function(x,lambda,alpha,beta,mu,Lambda){
}


dngamma <- function(x,lam,al,be,mu){
if( lam <= 0 )
stop("lambda must be positive.")
if( al <= 0 )
stop("alpha must be positive.")
if( al^2 - be^2 <= 0 )
stop("alpha^2 - beta^2 must be positive.")

dens <- exp(be*(x-mu))*((al^2 - be^2)^(lam))*besselK(al*abs(x-mu),lam-1/2)*abs(x-mu)^(lam-1/2)/(gamma(lam)*sqrt(pi)*((2*al)^(lam-1/2)))
dens
}


## ## One-dim. normal gamma
## rngamma <- function(x,lambda,alpha,beta,mu){
## tmp <- alpha^2 - beta^2
## if( lambda <= 0 )
## stop("lambda must be positive value.")
## if( alpha <= 0 )
## stop("alpha must be positive value.")
## if( tmp <= 0 )
## stop("alpha^2 - beta^2*mu must be positive value.")
## # if( det(Lambda) != 1)
## ## if( Lambda !=1)
## ## stop("Determinant of Lambda must be one.")

## tau <- rgamma(x,lambda,tmp/2)
## eta <- rnorm(x)
## ## z <- mu + beta * tau * Lambda + sqrt(tau * Lambda) * eta
## z <- mu + beta * tau + sqrt(tau) * eta
## X <- z
## return(X)
## }
dngamma <- function(x,lambda,alpha,beta,mu,Lambda){
## Error check
if(length(lambda)!=1||length(alpha)!=1)
stop("alpha and lambda must be positive reals.")
if( lambda <= 0 )
stop("lambda must be positive.")
if( alpha <= 0 )
stop("alpha must be positive.")
if(length(mu)!=length(beta)){
stop("Error: wrong input dimension.")
}
if(missing(Lambda))
Lambda <- NA
if(is.na(Lambda)){
## univariate case
if(length(mu)!=1 || length(beta)!=1){
stop("Error: wrong input dimension.")
}
if( alpha^2 - beta^2 <= 0 )
stop("alpha^2 - beta^2 must be positive.")

dens <- exp(beta*(x-mu))*((alpha^2 - beta^2)^(lambda))*besselK(alpha*abs(x-mu),lambda-1/2)*abs(x-mu)^(lambda-1/2)/(gamma(lambda)*sqrt(pi)*((2*alpha)^(lambda-1/2)))
dens}
else{ ## multivariate case
if( nrow(Lambda)!=ncol(Lambda)){
stop("Lambda must be a square matrix.")
}
if( nrow(Lambda)!=length(beta)){
stop("Dimension of Lambda and beta must be equal.")
}

if( min(eigen(Lambda)$value) <= 10^(-15) ){
stop("Lambda must be positive definite.")
}
if( det(Lambda) > 1+10^(-15) || det(Lambda) < 1-10^(-15) ){
stop("The determinant of Lambda must be 1.")
}

## rngamma <- function(x,lambda,alpha,beta,mu,Lambda){
## tmp <- alpha^2 - t(beta) %*% Lambda %*% beta
## if( lambda <= 0 )
## stop("lambda must be positive value.")
## if( alpha <= 0 )
## stop("alpha must be positive value.")
## if( tmp <= 0 )
## stop("alpha^2 - beta^2*mu must be positive value.")
## # if( det(Lambda) != 1)
## if( Lambda !=1)
## stop("Determinant of Lambda must be one.")

## tau <- rgamma(x,lambda,tmp/2)
## eta <- rnorm(x)
## z <- mu + beta * tau * Lambda + sqrt(tau * Lambda) * eta
## X <- z
## return(X)
## }
tmp <- as.numeric(alpha^2 - t(beta) %*% Lambda %*% beta)
if( tmp <=0)
stop("alpha^2 - t(beta) %*% Lambda %*% must be positive.")
Lambdainv<-solve(Lambda)
dens<- exp(t(beta)%*%(x-mu))*(alpha^2-t(beta)%*%Lambda%*%beta)^(lambda)*besselK(alpha*sqrt(t(x-mu)%*%Lambdainv%*%(x-mu)),lambda-nrow(Lambda)/2)*sqrt(t(x-mu)%*%Lambdainv%*%(x-mu))^{lambda-nrow(Lambda)/2}/(gamma(lambda)*pi^{nrow(Lambda)/2}*2^{nrow(Lambda)/2+lambda-1}*alpha^{lambda-nrow(Lambda)/2})
dens
}
}


## Inverse Gaussian
Expand Down Expand Up @@ -176,7 +196,7 @@ dIG <- function(x,delta,gamma){

## (Multivariate) Normal inverse Gaussian

rNIG <- function(x,alpha=1,beta=0,delta=1,mu=0,Lambda){
rNIG <- function(x,alpha,beta,delta,mu,Lambda){
## Error check
#print(match.call())
if(length(mu)!=length(beta)){
Expand Down Expand Up @@ -204,9 +224,14 @@ rNIG <- function(x,alpha=1,beta=0,delta=1,mu=0,Lambda){
return(X)

}else{ ## multivariate case
if( det(Lambda) < 10^(-15)){
stop("Determinant of Lambda must be one.")

if( min(eigen(Lambda)$value) <= 10^(-15) ){
stop("Lambda must be positive definite.")
}
if( det(Lambda) > 1+10^(-15) || det(Lambda) < 1-10^(-15) ){
stop("The determinant of Lambda must be 1.")
}

tmp <- as.numeric(alpha^2 - t(beta) %*% Lambda %*% beta)
if(tmp <0){
stop("alpha^2 - t(beta) %*% Lambda %*% beta must be nonnegative.")
Expand All @@ -226,19 +251,57 @@ rNIG <- function(x,alpha=1,beta=0,delta=1,mu=0,Lambda){
}


dNIG <- function(x,al,be,de,mu){
if( al < 0 )
stop("alpha must be nonnegative.")
if( al^2 - be^2 < 0 )
stop("alpha^2 - beta^2 must be nonnegative.")
if( de <= 0 )
stop("delta must be positive.")
dNIG <- function(x,alpha,beta,delta,mu,Lambda){
## Error check
#print(match.call())
if(length(alpha)>1||length(delta)>1)
stop("alpha and delta must be positive reals.")
if(length(mu)!=length(beta)){
stop("Error: wrong input dimension.")
}
if( alpha < 0 )
stop("alpha must be nonnegative.")
if( delta <= 0 )
stop("delta must be positive.")
if(missing(Lambda))
Lambda <- NA
if(is.na(Lambda)){
#univraiate case
if(length(beta)>1||length(mu)>1)
stop("beta and mu must be numeric")
if( alpha^2 - beta^2 < 0 )
stop("alpha^2 - beta^2 must be nonnegative.")
dens <- alpha*delta*exp(delta*sqrt(alpha^{2}-beta^{2})+beta*(x-mu))*besselK(alpha*sqrt(delta^{2}+(x-mu)^{2}),1)/(pi*sqrt(delta^{2}+(x-mu)^{2}))
dens
}else{
#multivariate case
if( nrow(Lambda)!=ncol(Lambda)){
stop("Lambda must be a square matrix.")
}
if( nrow(Lambda)!=length(beta)){
stop("Dimension of Lambda and beta must be equal.")
}
if(nrow(Lambda)!=length(mu)){
stop("Dimension of Lambda and mu must be equal.")
}

dens <- al*de*exp(de*sqrt(al^{2}-be^{2})+be*(x-mu))*besselK(al*sqrt(de^{2}+(x-mu)^{2}),1)/(pi*sqrt(de^{2}+(x-mu)^{2}))
dens
if( min(eigen(Lambda)$value) <= 10^(-15) ){
stop("Lambda must be positive definite.")
}
if( det(Lambda) > 1+10^(-15) || det(Lambda) < 1-10^(-15) ){
stop("The determinant of Lambda must be 1.")
}

tmp<-alpha-t(beta)%*%Lambda%*%beta
if(tmp <0){
stop("alpha^2 - t(beta) %*% Lambda %*% beta must be nonnegative.")
}
Lambdainv<-solve(Lambda)
dens<- alpha^{(nrow(Lambda)+1)/2}*delta*exp(delta*sqrt(tmp)+t(beta)%*%(x-mu))*besselK(alpha*sqrt(delta^2+t(x-mu)%*%Lambdainv%*%(x-mu)),nrow(Lambda))/(2^{(nrow(Lambda)-1)/2}*pi^{(nrow(Lambda)+1)/2}*(sqrt(delta^2+t(x-mu)%*%Lambdainv%*%(x-mu)))^{(nrow(Lambda)+1)/2})
dens
}
}


## ## One-dim. NIG
## rNIG <- function(x,alpha=1,beta=0,delta=1,mu=0){
## gamma <- sqrt(alpha^2 - beta^2)
Expand All @@ -255,9 +318,17 @@ dNIG <- function(x,al,be,de,mu){
## }


## Non-Gaussian stable: a bug modified on 1 Arp, 2015 (HM).
## Univariate non-Gaussian stable: corrected Weron's algorithm incorporated
## (20160114, HM) "dstable" still unavailable in YUIMA... incorporate "stabledist" package?

rstable <- function(x,alpha,beta,sigma,gamma){
if( alpha <= 0 || alpha > 2)
stop("The index alpha must take values in (0,2].")
if( beta < -1 || beta > 1)
stop("The skeweness beta must take values in [-1,1].")
if( sigma <= 0 )
stop("The scale sigma must be positive.")

a <- (1 + (beta*tan(alpha*pi/2))^2)^(1/(2*alpha))
b <- atan(beta*tan(alpha*pi/2))/alpha

Expand Down Expand Up @@ -293,6 +364,7 @@ rstable <- function(x,alpha,beta,sigma,gamma){
## }



## Positive exponentially tempered stable (AR method)
## ## This must be re-coded later!! (temporarily, rather inefficient)
rpts <- function(x,al,a,b) {
Expand Down
9 changes: 4 additions & 5 deletions man/adaBayes.Rd
View file
Original file line number Diff line number Diff line change
Expand Up @@ -4,19 +4,18 @@
\title{Adaptive Bayes estimator for the parameters in sde model}
\description{Adaptive Bayes estimator for the parameters in a specific type of sde.}
\usage{
adaBayes(yuima, start, prior,
lower, upper, method = "nomcmc")
adaBayes(yuima, start, prior, lower, upper, method = "nomcmc")
}
\arguments{
\item{yuima}{a 'yuima' object.}
\item{start}{ initial suggestion for parameter values }
\item{prior}{ a list of prior distributions for the parameters [function].}
\item{lower}{ ... }
\item{upper}{ ... }
\item{lower}{a named list for specifying lower bounds of parameters}
\item{upper}{a named list for specifying upper bounds of parameters}
\item{method}{ \code{nomcmc} requires package \code{cubature} }
}
\details{
Calculate the values of the parameters theta1 and theta2. When the quasi-likelihood is too large for the given data, the integral in the Bayes estimator may diverges. For such a case, offset values for the parameters can be specified not to diverge.}
Calculate the values of the parameters theta1 and theta2. When the quasi-likelihood is too large for the given data, the integral in the Bayes estimator may diverge. For such a case, offset values for the parameters can be specified not to diverge.}
\value{
\item{vector}{a vector of the paramter estimate}
}
Expand Down
2 changes: 1 addition & 1 deletion man/qmle.Rd
View file
Original file line number Diff line number Diff line change
Expand Up @@ -59,7 +59,7 @@ lse(yuima, start, lower, upper, method = "BFGS", ...)
\code{lse} calculates least squares estimators of the drift parameters. This is
useful for initial guess of \code{qmle} estimation.

\code{quasilogl} returns the valueof the quasi loglikelihood for a given
\code{quasilogl} returns the value of the quasi loglikelihood for a given
\code{yuima} object and list of parameters \code{coef}.

}
Expand Down

0 comments on commit 49eda69

Please sign in to comment.