[Yuima-commits] r431 - pkg/yuima/R

[noreply at r-forge.r-project.org]

Author: hirokimasuda
Date: 2016-05-19 08:33:01 +0200 (Thu, 19 May 2016)
New Revision: 431

Modified:
   pkg/yuima/R/rng.R
Log:
parameter-checking bug fixed; r(d)ngamma --> r(d)vgamma

Modified: pkg/yuima/R/rng.R
===================================================================
--- pkg/yuima/R/rng.R	2016-05-18 10:56:20 UTC (rev 430)
+++ pkg/yuima/R/rng.R	2016-05-19 06:33:01 UTC (rev 431)
@@ -45,9 +45,9 @@
 }
 
 
-## (Multivariate) Normal gamma
+## (Multivariate) Variance gamma
 
-rngamma <- function(x,lambda,alpha,beta,mu,Lambda){
+rvgamma <- function(x,lambda,alpha,beta,mu,Lambda){
   ## Error check
   if(length(mu)!=length(beta)){
     stop("Error: wrong input dimension.")
@@ -82,10 +82,12 @@
     if( nrow(Lambda)!=ncol(Lambda)){
       stop("Lambda must be a square matrix.")
     }
+    if(sum((Lambda-t(Lambda))*(Lambda-t(Lambda)))!=0){
+      stop("Lambda must be a symmetric 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.")
     }
@@ -100,7 +102,7 @@
     if( alpha <= 0 )
       stop("alpha must be positive.")
     if( tmp <=0)
-      stop("alpha^2 - t(beta) %*% Lambda %*% must be positive.")
+      stop("alpha^2 - t(beta) %*% Lambda %*% beta must be positive.")
     
     tau <- rgamma(x,lambda,tmp/2)
     eta <- rnorm(x*length(beta))
@@ -114,7 +116,7 @@
 }
 
 
-dngamma <- function(x,lambda,alpha,beta,mu,Lambda){
+dvgamma <- function(x,lambda,alpha,beta,mu,Lambda){
   ## Error check
   if(length(lambda)!=1||length(alpha)!=1)
     stop("alpha and lambda must be positive reals.")
@@ -141,6 +143,9 @@
     if( nrow(Lambda)!=ncol(Lambda)){
       stop("Lambda must be a square matrix.")
     }
+    if(sum((Lambda-t(Lambda))*(Lambda-t(Lambda)))!=0){
+      stop("Lambda must be a symmetric matrix")
+    }
     if( nrow(Lambda)!=length(beta)){
       stop("Dimension of Lambda and beta must be equal.")
     }
@@ -154,7 +159,7 @@
 
     tmp <- as.numeric(alpha^2 - t(beta) %*% Lambda %*% beta)
     if( tmp <=0)
-      stop("alpha^2 - t(beta) %*% Lambda %*% must be positive.")
+      stop("alpha^2 - t(beta) %*% Lambda %*% beta 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
@@ -202,6 +207,13 @@
   if(length(mu)!=length(beta)){
     stop("Error: wrong input dimension.")
   }
+  if(length(alpha)>1||length(delta)>1)
+    stop("alpha and delta must be positive reals.")
+  if( alpha < 0 )
+    stop("alpha must be nonnegative.")
+  if( delta <= 0 )
+    stop("delta must be positive.")
+  
   if(missing(Lambda))
    Lambda <- NA
 
@@ -224,7 +236,15 @@
     return(X)
     
   }else{  ## multivariate case
-  	
+    if( nrow(Lambda)!=ncol(Lambda)){
+      stop("Lambda must be a square matrix.")
+    }
+    if(sum((Lambda-t(Lambda))*(Lambda-t(Lambda)))!=0){
+      stop("Lambda must be a symmetric 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.")
     }
@@ -278,6 +298,9 @@
     if( nrow(Lambda)!=ncol(Lambda)){
       stop("Lambda must be a square matrix.")
     }
+    if(sum((Lambda-t(Lambda))*(Lambda-t(Lambda)))!=0){
+      stop("Lambda must be a symmetric matrix")
+    }
     if( nrow(Lambda)!=length(beta)){
       stop("Dimension of Lambda and beta must be equal.")
     }